MacHack 1997/MacHack 1997.toast/Hacks/Hacks ’94/[√] Distribution Restricted!/Christian Ruse/Fourier Paper + Apps/nih-image154_source.sea/V1.54 Source/Macros1.p

Text File | 1994-02-01 | 103KB | 4,760 lines

unit Macros1;
{Contains the recursive descent parser/interpreter}
{for Image's Pascal-like macro language.}

{References:}
{  "Pascal User Manual and Report", Kathleen Jensen and Niklaus Wirth, Springer-Verlag}
{  "Building Your Own C Interpreter", Dr. Dobb's Journal, August 1989}

interface

    uses
        QuickDraw, Palettes, Picker, PrintTraps, Globals, Utilities, Graphics, Edit, {}
        Analysis, Camera, File1, File2, Filters, Macros2, Stacks, Lut, Background, {}
        User, Serial, PlugIns, Text, projection, math; {,UMacroDef, UMacroRun}


    procedure RunMacro (nMacro: integer);
    procedure RunKeyMacro (ch: char; KeyCode: integer);
    procedure CloseSerialPorts;


implementation

    const
        EndExpected = '"end" or ";" expected';
        ThenExpected = '"then" expected';
        DivideByZero = 'Divide by zero';
        DoExpected = '"do" expected';
        UntilExpected = '"until" expected';
        RightParenExpected = '")" expected';
        NoImageOpen = 'No Image open';
        MaxArgs = 25;

    var
        nSaves, ErrorPC, LineStartPC: integer;
        DoOption: boolean;
        SaveBackground, SavePicWidth, SavePicHeight: integer;
        SaveMethod: rsMethodType;
        SaveCreate, SaveInvertY, SaveScaleArithmetic, SaveScaleConvolutions: boolean;
        SaveAngle, SaveH, SaveV: real;
        MacroOpPending, StringsAllocated, InPhotoMode: boolean;
        RoutinesCalled: set of CommandType;



    function GetExpression: extended;
    forward;
    procedure DoStatement;
    forward;
    procedure SkipStatement;
    forward;
    procedure DoFor;
    forward;
    procedure MacroError (str: str255);
    forward;
    function GetString: str255;
    forward;
    function GetInteger: LongInt;
    forward;
    procedure SkipIf;
    forward;
    procedure SkipPartialStatement;
    forward;


{$S MacroUtil}
{Routines from here to the $S compiler directive go in the MacroUtil segment}


    procedure PutTokenBack;
    begin
        if token <> DoneT then begin
                pc := SavePC;
                token := SaveToken;
            end;
    end;


    procedure DeallocateStrings (first, last: integer);
        var
            i: integer;
    begin
        with MacrosP^ do begin
                for i := first to last do begin
                        if Stack[i].StringH <> nil then begin
                                DisposHandle(handle(Stack[i].StringH));
                                Stack[i].StringH := nil;
                            end;
                    end;
            end;
    end;


    procedure TrimString (var str: str255);
    begin
        if length(str) > 0 then begin
                while (length(str) > 1) and (str[1] = ' ') do
                    delete(str, 1, 1);
                while (length(str) > 1) and ((str[length(str)] = ' ') or (str[length(str)] = ';')) do
                    delete(str, length(str), 1);
            end;
    end;


    procedure LookupVariable;
        var
            VarFound: boolean;
            i: integer;
    begin
        with MacrosP^ do begin
                VarFound := false;
                i := TopOfStack + 1;
                repeat
                    i := i - 1;
                    VarFound := SymbolTableLoc = Stack[i].SymbolTableIndex
                until VarFound or (i = 1);
                if VarFound then
                    with stack[i] do begin
                            TokenValue := value;
                            if vType <> StringVar then
                                token := Variable
                            else begin
                                    token := StringVariable;
                                    if StringH <> nil then
                                        TokenStr := StringH^^
                                    else
                                        TokenStr := 'Deallocated String';
                                end;
                            TokenStackLoc := i;
                        end;
            end; {with}
    end;


    function FetchInteger: integer;
        var
            temp: integer;
    begin
        with macrosP^ do begin
                temp := ord(macros[pc]);
                pc := pc + 1;
                FetchInteger := bor(bsl(temp, 8), ord(macros[pc]));
                pc := pc + 1;
            end;
    end;


    procedure LookupProcedure;
    begin
        with MacrosP^ do begin
                SymbolTableLoc := FetchInteger;
                with SymbolTable[SymbolTableLoc] do begin
                        TokenLoc := loc;
                        TokenSymbol := symbol;
                    end;
            end;
    end;


    function FetchReal: real;
        var
            temp: LongInt;
    begin
        with macrosP^ do begin
                temp := ord(macros[pc]);
                pc := pc + 1;
                temp := bor(bsl(temp, 8), ord(macros[pc]));
                pc := pc + 1;
                temp := bor(bsl(temp, 8), ord(macros[pc]));
                pc := pc + 1;
                temp := bor(bsl(temp, 8), ord(macros[pc]));
                pc := pc + 1;
                FetchReal := real(temp);
            end;
    end;


    procedure GetToken;
    begin
        with MacrosP^ do begin
                if token = DoneT then
                    exit(GetToken);
                SavePC := PC;
                SaveToken := token;
                token := TokenType(macros[pc]);
                while token = NewLineT do begin
                        MacroLineNumber := MacroLineNumber + 1;
                        pc := pc + 1;
                        LineStartPC := pc;
                        if pc > EndMacros then begin
                                Token := DoneT;
                                exit(GetToken);
                            end;
                        SavePC := PC;
                        SaveToken := token;
                        token := TokenType(macros[pc]);
                    end;
                pc := pc + 1;
                if pc > EndMacros then begin
                        Token := DoneT;
                        exit(GetToken);
                    end;
                case token of
                    CommandT, FunctionT, StringFunctionT, ArrayT, UserCommandT, UserFuncT, UserStrFuncT:
                        MacroCommand := CommandType(FetchInteger);
                    Identifier:  begin
                            SymbolTableLoc := FetchInteger;
                            if TopOfStack > 0 then
                                LookupVariable;
                        end;
                    ProcedureT:
                        LookupProcedure;
                    NumericLiteral:
                        TokenValue := FetchReal;
                    StringLiteral:  begin
                            TokenStr := '';
                            while macros[pc] <> chr(0) do begin
                                    TokenStr := concat(TokenStr, macros[pc]);
                                    pc := pc + 1;
                                end;
                            pc := pc + 1;
                        end;
                end; {case}
            end; {with}
    end;


    procedure GetMacroName;
        var
            i, len: integer;
    begin
        with MacrosP^ do begin
                pc := PCStart;
                repeat
                    pc := pc - 1;
                    if pc < 0 then
                        exit(GetMacroName);
                until macros[pc] = chr(ord(MacroT));
                GetToken; {MacroT}
                GetToken; {Macro name}
                if Token = StringLiteral then begin
                        len := length(TokenStr);
                        if len > SymbolSize then
                            len := SymbolSize;
                        for i := 1 to len do
                            MacroOrProcName[i] := TokenStr[i];
                    end;
            end;
    end;


    procedure ConvertTokenToString (t: TokenType; var str: str255);
        var
            i, j, len: integer;
    begin
        with MacrosP^ do
            case token of
                semicolon:
                    str := ';';
                comma:
                    str := ',';
                colon:
                    str := ':';
                LeftParen:
                    str := '(';
                RightParen:
                    str := ')';
                LeftBracket:
                    str := '[';
                RightBracket:
                    str := ']';
                PlusOp:
                    str := '+';
                MinusOp:
                    str := '-';
                MulOp:
                    str := '*';
                DivOp:
                    str := '/';
                eqOp:
                    str := '=';
                ltOp:
                    str := '<';
                gtOp:
                    str := '>';
                neOp:
                    str := '<>';
                leOp:
                    str := '<=';
                geOp:
                    str := '>=';
                orOp:
                    str := 'or';
                IntDivOp:
                    str := 'div';
                modOp:
                    str := 'mod';
                andOp:
                    str := 'and';
                NotOp:
                    str := 'not';
                AssignOp:
                    str := ':=';
                Identifier, Variable, StringVariable, ProcIdT:  begin
                        for i := 1 to SymbolSize do
                            str := concat(str, SymbolTable[SymbolTableLoc].symbol[i]);
                        TrimString(str);
                    end;
                NumericLiteral:  begin
                        if trunc(TokenValue) = TokenValue then
                            RealToString(TokenValue, 1, 0, str)
                        else
                            RealToString(TokenValue, 1, 1, str);
                    end;
                StringLiteral:
                    str := concat('''', TokenStr, '''');
                CommandT, FunctionT, StringFunctionT, ArrayT, UserCommandT, UserFuncT, UserStrFuncT:
                    for i := 1 to nSymbols do begin
                            with SymbolTable[i] do
                                if (tType = token) and (MacroCommand = cType) then begin
                                        for j := 1 to SymbolSize do
                                            str := concat(str, symbol[j]);
                                        TrimString(str);
                                    end;
                        end; {for}
                otherwise
                    for i := 1 to nSymbols do begin
                            with SymbolTable[i] do
                                if tType = token then begin
                                        for j := 1 to SymbolSize do
                                            str := concat(str, symbol[j]);
                                        TrimString(str);
                                    end;
                        end; {for}
            end; {case}
    end;


    procedure GetErrorLine (var ErrorLine: str255);
        var
            str: str255;
    begin
        with MacrosP^ do begin
                pc := LineStartPC;
                ErrorLine := '';
                repeat
                    str := '';
                    if macros[pc] = chr(ord(NewLineT)) then
                        leave;
                    GetToken;
                    ConvertTokenToString(token, str);
                    if SavePC = ErrorPC then
                        str := concat('«', str, '»');
                    ErrorLine := concat(ErrorLine, ' ', str);
                until token = DoneT;
            end;
    end;


    procedure GetLineNumber;
    begin
        pc := PCStart;
        MacroLineNumber := 1;
        while (pc <= errorpc) and (token <> DoneT) do
            GetToken;
    end;


    procedure MacroError (str: str255);
  {Report run-time errors}
        var
            name, ErrorLine: str255;
            i, count, ignore: integer;
    begin
        with MacrosP^ do begin
                if token = DoneT then
                    exit(MacroError);
                if TopOfStack > 0 then
                    DeAllocateStrings(nGlobals + 1, TopOfStack);
                ErrorPC := SavePC;
                if MacroOrProcName = BlankSymbol then
                    GetMacroName;
                if MacroOrProcName[SymbolSize] <> ' ' then
                    MacroOrProcName[SymbolSize] := '…';
                name := MacroOrProcName;
                TrimString(name);
                GetLineNumber;
                GetErrorLine(ErrorLine);
                InitCursor;
                ParamText(str, long2str(MacroLineNumber), Name, ErrorLine);
                Ignore := Alert(900, nil);
                Token := DoneT;
            end; {with}
    end;


    procedure DoDeclaration;
        var
            SaveStackLoc, StackLoc: integer;
    begin
        SaveStackLoc := TopOfStack;
        while (token = Identifier) or (token = variable) or (token = comma) or (token = StringVariable) do begin
                if token = StringVariable then begin
                        MacroError('Variable previously defined');
                        exit(DoDeclaration);
                    end;
                if TopOfStack >= MaxStackSize then begin
                        MacroError(StackOverflow);
                        exit(DoDeclaration);
                    end;
                TopOfStack := TopOfStack + 1;
                with MacrosP^.stack[TopOfStack] do begin
                        SymbolTableIndex := SymbolTableLoc;
                        value := 0.0;
                        StringH := nil;
                    end;
                GetToken;
                if token = comma then
                    GetToken;
            end; {while}
        if token <> colon then
            MacroError('":" expected');
        GetToken;
        if (token <> IntegerT) and (token <> RealT) and (token <> BooleanT) and (token <> StringT) then
            MacroError('"integer", "real", "boolean" or "string" expected');
        for StackLoc := SaveStackLoc + 1 to TopOfStack do
            with macrosP^.stack[StackLoc] do
                case token of
                    IntegerT:
                        vType := IntVar;
                    RealT:
                        vType := RealVar;
                    BooleanT:
                        vType := BooleanVar;
                    StringT:  begin
                            StringsAllocated := true;
                            vType := StringVar;
                            StringH := str255H(NewHandle(SizeOf(str255)));
                            if StringH = nil then begin
                                    MacroError('Out of memory');
                                    Token := DoneT
                                end
                            else
                                StringH^^ := 'Local String';
                        end;
                    otherwise
                end;
        GetToken;
        if Token = SemiColon then
            GetToken;
    end;


    procedure GetLeftParen;
    begin
        GetToken;
        if token <> LeftParen then
            MacroError('"(" expected');
    end;


    procedure GetRightParen;
    begin
        GetToken;
        if token <> RightParen then
            MacroError(RightParenExpected);
    end;


    procedure GetComma;
    begin
        GetToken;
        if token <> comma then
            MacroError('"," expected');
    end;


    procedure GetArguments (var str: str255);
        var
            width, fwidth: integer;
            i: LongInt;
            isExpression, ZeroFill, noArgs: boolean;
            n: extended;
            str2: str255;
    begin
        if MacroCommand = WritelnC then begin {Check for Writeln with no arguments}
                GetToken;
                noArgs := token <> LeftParen;
                PutTokenBack;
                if NoArgs then begin
                        str := '';
                        exit(GetArguments);
                    end;
            end;
        ZeroFill := not (MacroCommand in [DrawTextC, WriteC, WritelnC, PutMsgC, ShowMsgC, PutSerialC, ConcatC]);
        width := 4;
        fwidth := 0;
        str := '';
        GetLeftParen;
        GetToken;
        repeat
            isExpression := token in [Variable, NumericLiteral, FunctionT, UserFuncT, TrueT, FalseT, ArrayT, MinusOp, LeftParen];
            PutTokenBack;
            if isExpression then
                n := GetExpression
            else
                str2 := GetString;
            GetToken;
            if token = colon then begin
                    width := GetInteger;
                    if width < 0 then
                        width := 0;
                    if width > 100 then
                        width := 100;
                    GetToken;
                    if token = colon then begin
                            fwidth := GetInteger;
                            if fwidth < 0 then
                                width := 0;
                            if fwidth > 12 then
                                width := 12;
                            GetToken;
                        end;
                end;
            if token = comma then
                GetToken;
            if isExpression then begin
                    RealToString(n, width, fwidth, str2);
                    if ZeroFill and (n >= 0) then
                        for i := 1 to width do
                            if str2[i] = ' ' then
                                str2[i] := '0';
                end;
            str := concat(str, str2);
        until (token = RightParen) or (token = DoneT);
    end;


    procedure DoUserToken;
    begin
        MacroError('UMX package not installed');
    end;


    function DoGetString: str255; {(prompt,default:str255)}
        const
            StringID = 3;
        var
            prompt, default: str255;
            Canceled: boolean;
            mylog: DialogPtr;
            item: integer;
    begin
        GetLeftParen;
        prompt := GetString;
        GetToken;
        if token = Comma then
            default := GetString
        else begin
                default := '';
                PutTokenBack
            end;
        GetRightParen;
        if Token <> DoneT then begin
                InitCursor;
                ParamText(prompt, '', '', '');
                mylog := GetNewDialog(170, nil, pointer(-1));
                SetDString(MyLog, StringID, default);
                SelIText(MyLog, StringID, 0, 32767);
                OutlineButton(MyLog, ok, 16);
                repeat
                    ModalDialog(nil, item);
                until (item = ok) or (item = cancel);
                if item = ok then
                    DoGetString := GetDString(MyLog, StringID)
                else begin
                        DoGetString := 'cancel';
                        token := DoneT;
                    end;
                DisposDialog(mylog);
            end;
    end;


    function GetSerial: str255;
        var
            count: LongInt;
            buffer: packed array[1..100] of char;
            err: OSErr;
    begin
        if SerialBufferP = nil then begin
                MacroError('Serial port not open');
                exit(GetSerial);
            end;
        Err := SerGetBuf(SerialIn, count);
        if count > 0 then begin
                count := 1;
                Err := FSRead(SerialIn, count, @buffer);
                GetSerial := buffer[1]
            end
        else
            GetSerial := '';
    end;


    procedure RangeCheck (i: LongInt);
    begin
        if (i < 0) or (i > 255) then
            MacroError('Argument is less than 0 or greater than 255');
    end;


    function DoChr: str255;
        var
            i: LongInt;
    begin
        GetLeftParen;
        i := GetInteger;
        GetRightParen;
        RangeCheck(i);
        if Token <> DoneT then
            DoChr := chr(i);
    end;


    function GetWindowTitle: str255;
        var
            wPeek: WindowPeek;
    begin
        wPeek := WindowPeek(FrontWindow);
        if wPeek = nil then begin
                GetWindowTitle := '';
                exit(GetWindowTitle);
            end;
        if wPeek^.WindowKind = PicKind then
            GetWindowTitle := Info^.title
        else
            GetWindowTitle := wPeek^.TitleHandle^^;
    end;


    function DoStringFunction: str255;
        var
            str: str255;
    begin
        case MacroCommand of
            GetStringC:
                DoStringFunction := DoGetString;
            ChrC:
                DoStringFunction := DoChr;
            GetSerialC:
                DoStringFunction := GetSerial;
            ConcatC:  begin
                    GetArguments(str);
                    DoStringFunction := str;
                end;
            WindowTitleC:
                DoStringFunction := GetWindowTitle;
            otherwise
                MacroError('"GetString ", "GetSerial" or "chr" expected');
        end;
    end;


    function GetString: str255;
    begin
        GetToken;
        if token = StringFunctionT then
            GetString := DoStringFunction
        else if token = UserStrFuncT then begin
                DoUserToken; {result in TokenStr}
                GetString := TokenStr;
            end
        else if (token = StringLiteral) or (token = StringVariable) then
            GetString := TokenStr
        else begin
                MacroError('String expected');
                GetString := '';
            end;
    end;


    function GetInteger: LongInt;
        var
            n: LongInt;
            r: extended;
    begin
        r := GetExpression;
        if token = DoneT then begin
                GetInteger := 0;
                exit(GetInteger);
            end;
        GetInteger := round(r);
    end;


    procedure CheckBoolean (b: extended);
    begin
        if (b <> ord(true)) and (b <> ord(false)) then
            MacroError('Boolean expression expected');
    end;


    function GetBoolean: boolean;
        var
            value: extended;
    begin
        value := GetExpression;
        CheckBoolean(value);
        GetBoolean := value = ord(true);
    end;


    function GetBooleanArg: boolean;
    begin
        GetLeftParen;
        GetBooleanArg := GetBoolean;
        GetRightParen;
    end;


    function GetStringArg: str255;
    begin
        GetLeftParen;
        GetStringArg := GetString;
        GetRightParen;
    end;


    procedure DoConvolve;
        var
            err: OSErr;
            f: integer;
            FileFound: boolean;
            fname: str255;
    begin
        fname := GetStringArg;
        if token <> DoneT then begin
                if (fname = '') and (CurrentWindow = TextKind) then begin
                        ConvolveUsingText;
                        exit(DoConvolve);
                    end;
                err := fsopen(fname, KernelsRefNum, f);
                FileFound := err = NoErr;
                err := fsclose(f);
                if FileFound then
                    convolve(fname, KernelsRefNum)
                else
                    convolve('', 0);
            end;
    end;


    function GetNumber: extended; {(prompt:str255; default:extended)}
        var
            prompt: str255;
            default, n: extended;
            Canceled: boolean;
    begin
        GetLeftParen;
        prompt := GetString;
        GetComma;
        default := GetExpression;
        GetRightParen;
        n := 0.0;
        if Token <> DoneT then begin
                n := GetReal(prompt, default, Canceled);
                if Canceled then begin
                        n := default;
                        token := DoneT;
                    end;
            end;
        GetNumber := n;
    end;


    function DoGetPixel: extended; {(hloc,vloc:integer)}
        var
            hloc, vloc: integer;
    begin
        GetLeftParen;
        hloc := GetInteger;
        GetComma;
        vloc := GetInteger;
        GetRightParen;
        if (Token <> DoneT) and (info <> NoInfo) then
            DoGetPixel := MyGetPixel(hloc, vloc)
        else
            DoGetPixel := 0.0;
    end;


    function DoFunction (c: CommandType): extended;
        var
            n: extended;
            SaveCommand: CommandType;
    begin
        SaveCommand := MacroCommand;
        GetLeftParen;
        n := GetExpression;
        GetRightParen;
        if Token <> DoneT then
            case SaveCommand of
                truncC:
                    DoFunction := trunc(n);
                roundC:
                    DoFunction := round(n);
                oddC:
                    if odd(trunc(n)) then
                        DoFunction := ord(true)
                    else
                        DoFunction := ord(false);
                absC:
                    DoFunction := abs(n);
                sqrtC:
                    if n < 0.0 then
                        MacroError('Sqrt Error')
                    else
                        DoFunction := sqrt(n);
                sqrC:
                    DoFunction := sqr(n);
                sinC:
                    DoFunction := sin(n);
                cosC:
                    DoFunction := cos(n);
                expC:
                    DoFunction := exp(n);
                lnC:
                    if n <= 0.0 then
                        MacroError('Log Error')
                    else
                        DoFunction := ln(n);
                arctanC:
                    DoFunction := arctan(n);
            end
        else
            DoFunction := 0.0;
    end;


    function CalibrateValue: extended;
        var
            i: integer;
    begin
        GetLeftParen;
        i := GetInteger;
        GetRightParen;
        RangeCheck(i);
        if Token <> DoneT then begin
                CalibrateValue := cvalue[i];
            end;
    end;


    function DoOrd: extended;
        var
            str: str255;
    begin
        GetLeftParen;
        str := GetString;
        GetRightParen;
        if Token <> DoneT then begin
                if length(str) >= 1 then
                    DoOrd := ord(str[1])
                else
                    DoOrd := -1;
            end;
    end;


    function DoStringToNum: extended;
        var
            str: str255;
            n: extended;
    begin
        GetLeftParen;
        str := GetString;
        GetRightParen;
        if Token <> DoneT then begin
                n := StringToReal(str);
                if n = BadReal then
                    DoStringToNum := 0.0
                else
                    DoStringToNum := n;
            end;
    end;


    function DoLogicalFunction (c: CommandType): extended;
        var
            n1, n2: LongInt;
    begin
        GetLeftParen;
        n1 := GetInteger;
        GetComma;
        n2 := GetInteger;
        GetRightParen;
        if Token <> DoneT then begin
                if c = BitAndC then
                    DoLogicalFunction := band(n1, n2)
                else
                    DoLogicalFunction := bor(n1, n2)
            end;
    end;


    function PidExists: boolean; {(pid:integer)}
        var
            pid, i: integer;
    begin
        GetLeftParen;
        pid := GetInteger;
        GetRightParen;
        if Token <> DoneT then begin
                PidExists := false;
                for i := 1 to nPics do
                    if InfoPtr(WindowPeek(PicWindow[i])^.RefCon)^.pidNum = pid then begin
                            PidExists := true;
                            leave;
                        end;
            end;
    end;


    function DoPos: integer;
        var
            substr, str: str255;
            n: extended;
    begin
        GetLeftParen;
        substr := GetString;
        GetComma;
        str := GetString;
        GetRightParen;
        if Token <> DoneT then
            DoPos := pos(substr, str);
    end;


    function ExecuteFunction: extended;
    begin
        case MacroCommand of
            TruncC, RoundC, oddC, absC, sqrtC, sqrC, sinC, cosC, expC, lnC, arctanC:
                ExecuteFunction := DoFunction(MacroCommand);
            GetNumC:
                ExecuteFunction := GetNumber;
            RandomC:
                ExecuteFunction := (random + 32767.0) / 65534.0;
            GetPixelC:
                ExecuteFunction := DoGetPixel;
            ButtonC:  begin
                    ExecuteFunction := ord(Button);
                    FlushEvents(EveryEvent, 0);
                end;
            nPicsC:
                ExecuteFunction := nPics;
            PicNumC:
                ExecuteFunction := info^.PicNum;
            PidNumC:
                ExecuteFunction := info^.PidNum;
            PidExistsC:
                ExecuteFunction := ord(PidExists);
            SameSizeC:
                ExecuteFunction := ord(AllSameSize);
            cValueC:
                ExecuteFunction := CalibrateValue;
            CalibratedC:
                ExecuteFunction := ord(info^.DensityCalibrated);
            rCountC:
                ExecuteFunction := mCount;
            GetSliceC:
                with info^ do
                    if StackInfo = nil then
                        ExecuteFunction := 0
                    else
                        ExecuteFunction := Info^.StackInfo^.CurrentSlice;
            nSlicesC:
                with info^ do
                    if StackInfo = nil then
                        ExecuteFunction := 0
                    else
                        ExecuteFunction := Info^.StackInfo^.nSlices;
            GetSpacingC:
                with info^ do
                    if StackInfo = nil then
                        MacroError('No stack')
                    else
                        ExecuteFunction := Info^.StackInfo^.SliceSpacing;
            nCoordinatesC:
                ExecuteFunction := nCoordinates;
            OrdC:
                ExecuteFunction := DoOrd;
            TickCountC:
                ExecuteFunction := TickCount;
            StringToNumC:
                ExecuteFunction := DoStringToNum;
            UndoSizeC:
                ExecuteFunction := UndoBufSize;
            BitAndC, BitOrC:
                ExecuteFunction := DoLogicalFunction(MacroCommand);
            PosC:
                ExecuteFunction := DoPos;
        end; {case}
    end;


    procedure CheckIndex (index: LongInt; min, max: extended);
    begin
        if (index < min) or (index > max) then
            MacroError('Array index out of range');
    end;


    function GetArrayValue: extended;
        var
            SaveCommand: CommandType;
            Index: LongInt;
            xcoord, ycoord: integer;
    begin
        SaveCommand := MacroCommand;
        GetToken;
        if token <> LeftBracket then
            MacroError('"[" expected');
        Index := GetInteger;
        GetToken;
        if token <> RightBracket then
            MacroError('"]" expected');
        case SaveCommand of
            HistogramC:  begin
                    CheckIndex(Index, 0, 255);
                    GetArrayValue := histogram[Index];
                end;
            rAreaC:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := mArea^[Index];
                end;
            rMeanC:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := mean^[Index];
                end;
            rStdDevC:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := sd^[Index];
                end;
            rXC:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := xcenter^[Index];
                end;
            rYC:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := ycenter^[Index];
                end;
            rLengthC:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := pLength^[Index];
                end;
            rMinC:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := mMin^[Index];
                end;
            rMaxC:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := mMax^[Index];
                end;
            rMajorC:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := MajorAxis^[Index];
                end;
            rMinorC:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := MinorAxis^[Index];
                end;
            rAngleC:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := orientation^[Index];
                end;
            rUser1C:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := User1^[Index];
                end;
            rUser2C:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := User2^[Index];
                end;
            RedLutC, GreenLutC, BlueLutC:  begin
                    CheckIndex(Index, 0, 255);
                    if Token <> DoneT then
                        with cScreenPort^.portPixMap^^.pmTable^^.ctTable[index].rgb do
                            case SaveCommand of
                                RedLutC:
                                    GetArrayValue := band(bsr(red, 8), 255);
                                GreenLutC:
                                    GetArrayValue := band(bsr(green, 8), 255);
                                BlueLutC:
                                    GetArrayValue := band(bsr(blue, 8), 255);
                            end; {case}
                end;
            BufferC:  begin
                    CheckIndex(Index, 0, MaxLine - 1);
                    if Token <> DoneT then
                        GetArrayValue := MacrosP^.aLine[index];
                end;
            PlotDataC:  begin
                    CheckIndex(Index, 0, MaxLine - 1);
                    if Token <> DoneT then
                        GetArrayValue := PlotData^[index];
                end;
            xCoordinatesC:  begin
                    CheckIndex(Index, 1, MaxCoordinates);
                    if Token <> DoneT then
                        with info^ do begin
                                xcoord := xCoordinates^[index];
                                if SpatiallyCalibrated then
                                    GetArrayValue := xcoord / xSpatialScale
                                else
                                    GetArrayValue := xcoord
                            end;
                end;
            yCoordinatesC:  begin
                    CheckIndex(Index, 1, MaxCoordinates);
                    if Token <> DoneT then
                        with info^ do begin
                                ycoord := yCoordinates^[index];
                                if InvertYCoordinates and (Info <> NoInfo) then
                                    ycoord := Info^.PicRect.bottom - ycoord - 1;
                                if SpatiallyCalibrated then
                                    GetArrayValue := ycoord / ySpatialScale
                                else
                                    GetArrayValue := ycoord
                            end;
                end;
            ScionC:  begin
                    if framegrabber <> ScionLG3 then
                        MacroError('No Scion LG-3');
                    if Token <> DoneT then
                        CheckIndex(Index, 1, 4);
                    if Token <> DoneT then
                        case index of
                            1:
                                GetArrayValue := LG3DacA;
                            2:
                                GetArrayValue := LG3DacB;
                            3:
                                GetArrayValue := ControlReg^;
                            4:
                                GetArrayValue := LG3DataOut;
                        end;
                end;
        end; {case}
    end;


    function GetStringValue: extended;
 {Convert string to a base 102 number so we can do comparisons.}
        const
            base = 102;
        var
            i, j: integer;
            v, k: extended;
    begin
        MakeLowerCase(TokenStr);
        k := 1;
        v := 0.0;
        for i := 1 to length(TokenStr) do begin
                j := ord(TokenStr[i]);
                if j > 127 then
                    j := 127;
                if j >= 91 then
                    j := j - 26;
                v := v + j * k;
                k := k * base;
            end;
        GetStringValue := v;
    end;


    function GetValue: extended;
    begin
        case token of
            Variable, NumericLiteral:
                GetValue := TokenValue;
            FunctionT:
                GetValue := ExecuteFunction;
            StringFunctionT:  begin
                    TokenStr := DoStringFunction;
                    GetValue := GetStringValue;
                end;
            UserFuncT:  begin
                    DoUserToken;{output in TokenValue}
                    GetValue := TokenValue;
                end;
            UserStrFuncT:  begin
                    DoUserToken; {output in TokenStr}
                    GetValue := GetStringValue;
                end;
            TrueT:
                GetValue := ord(true);
            FalseT:
                GetValue := ord(false);
            ArrayT:
                GetValue := GetArrayValue;
            StringVariable, StringLiteral:
                GetValue := GetStringValue;
            otherwise begin
                    MacroError('Number expected');
                    GetValue := 0.0;
                    exit(GetValue);
                end;
        end; {case}
    end;


    function GetFactor: extended;
        var
            fValue: extended;
            isUnaryMinus, isNot: boolean;
    begin
        GetToken;
        isUnaryMinus := token = MinusOp;
        isNot := token = NotOp;
        if isUnaryMinus or isNot then
            GetToken;
        case token of
            Variable, NumericLiteral, FunctionT, StringFunctionT, UserFuncT, {}
            UserStrFuncT, TrueT, FalseT, ArrayT, StringVariable, StringLiteral:
                fValue := GetValue;
            LeftParen:  begin
                    fValue := GetExpression;
                    GetRightParen;
                end;
            otherwise begin
                    macroError('Undefined identifier');
                    fvalue := 0.0
                end;
        end;
        GetToken;
        if isUnaryMinus then
            fValue := -fValue;
        if isNot then
            if fValue = ord(true) then
                fValue := ord(false)
            else
                fValue := ord(true);
        GetFactor := fValue;
    end;


    function GetTerm: extended;
        var
            tValue, fValue: extended;
            op: TokenType;
    begin
        tValue := GetFactor;
        while token in [MulOp, IntDivOp, ModOp, DivOp, AndOp] do begin
                op := token;
                fValue := GetFactor;
                case op of
                    MulOp:
                        tValue := tValue * fValue;
                    IntDivOp:
                        if fValue <> 0.0 then
                            tValue := trunc(tValue) div trunc(fValue)
                        else
                            MacroError(DivideByZero);
                    ModOp:
                        if fValue <> 0.0 then
                            tValue := trunc(tValue) mod trunc(fValue)
                        else
                            MacroError(DivideByZero);
                    DivOp:
                        if fValue <> 0.0 then
                            tValue := tValue / fValue
                        else
                            MacroError(DivideByZero);
                    AndOp:  begin
                            CheckBoolean(tValue);
                            CheckBoolean(fValue);
                            tValue := ord((tValue = ord(true)) and (fValue = ord(true)));
                        end;
                end; {case}
            end; {while}
        GetTerm := tValue;
    end;


    function GetSimpleExpression: extended;
        var
            seValue, tValue: extended;
            op: TokenType;
    begin
        seValue := GetTerm;
        while token in [PlusOp, MinusOp, OrOp] do begin
                op := token;
                tValue := GetTerm;
                case op of
                    PlusOp:
                        seValue := seValue + tValue;
                    MinusOp:
                        seValue := seValue - tValue;
                    orOp:  begin
                            CheckBoolean(seValue);
                            CheckBoolean(tValue);
                            seValue := ord((seValue = ord(true)) or (tValue = ord(true)));
                        end;
                end;
            end;
        GetSimpleExpression := seValue;
    end;


    function GetExpression: extended;
        var
            eValue, seValue: extended;
            op: TokenType;
    begin
        eValue := GetSimpleExpression;
        while token in [eqOp, ltOp, gtOp, neOp, leOp, geOp] do begin
                op := token;
                seValue := GetSimpleExpression;
                case op of
                    eqOp:
                        eValue := ord(eValue = seValue);
                    ltOp:
                        eValue := ord(eValue < seValue);
                    gtOp:
                        eValue := ord(eValue > seValue);
                    neOp:
                        eValue := ord(eValue <> seValue);
                    leOp:
                        eValue := ord(eValue <= seValue);
                    geOp:
                        eValue := ord(eValue >= seValue);
                end;
            end;
        GetExpression := eValue;
        PutTokenBack;
    end;


{$S}
{Routines from here to the end of the file go in the macro1 segment}

    procedure DoCapture;
    begin
        CaptureAndDisplayFrame;
        if ContinuousHistogram then
            ShowContinuousHistogram;
    end;


    procedure DoWait;
        var
            seconds: extended;
            SaveTicks: LongInt;
            str: str255;
    begin
        GetLeftParen;
        seconds := GetExpression;
        GetRightParen;
        if Token <> DoneT then begin
                SaveTicks := TickCount + round(seconds * 60.0);
                repeat
                    if Digitizing then
                        DoCapture;
                until (TickCount > SaveTicks) or CommandPeriod;
            end;
    end;


    procedure SetDensitySlice; {LowerLevel,UpperLevel:integer}
  {Disable density slicing if lower and upper=0 and enable it up lower and upper=255}
        var
            sStart, sEnd: integer;
    begin
        GetLeftParen;
        sStart := GetInteger;
        RangeCheck(sStart);
        GetComma;
        sEnd := GetInteger;
        RangeCheck(sEnd);
        GetRightParen;
        if Token <> DoneT then begin
                DisableDensitySlice;
                DisableThresholding;
                if (sEnd < sStart) or ((sStart = 0) and (sEnd = 0)) then
                    exit(SetDensitySlice);
                if not ((sStart = 255) and (sEnd = 255)) then begin
                        SliceStart := sStart;
                        SliceEnd := sEnd;
                        if SliceStart < 1 then
                            SliceStart := 1;
                        if SliceEnd > 254 then
                            SliceEnd := 254;
                    end;
                EnableDensitySlice;
            end;
    end;


    procedure SetColor;
        var
            index: integer;
            SaveCommand: CommandType;
    begin
        SaveCommand := MacroCommand;
        GetLeftParen;
        index := GetInteger;
        GetRightParen;
        RangeCheck(index);
        if Token <> DoneT then begin
                if SaveCommand = SetForeC then
                    SetForegroundColor(index)
                else
                    SetBackgroundColor(index);
            end;
    end;


    procedure DoConstantArithmetic;
        var
            constant: extended;
            SaveCommand: CommandType;
    begin
        SaveCommand := MacroCommand;
        GetLeftParen;
        constant := GetExpression;
        GetRightParen;
        if token <> DoneT then
            case SaveCommand of
                AddConstC:
                    DoArithmetic(AddItem, constant);
                MulConstC:
                    DoArithmetic(MultiplyItem, constant);
            end;
    end;


    procedure GetNextWindow;
        var
            n: integer;
    begin
        n := info^.PicNum + 1;
        if n > nPics then
            n := 1;
        StopDigitizing;
        SaveRoi;
        DisableDensitySlice;
        SelectWindow(PicWindow[n]);
        Info := pointer(WindowPeek(PicWindow[n])^.RefCon);
        ActivateWindow;
        GenerateValues;
        LoadLUT(info^.cTable);
        UpdatePicWindow;
    end;


    procedure DoRevert;
    begin
        if info^.revertable then begin
                RevertToSaved;
                UpdatePicWindow;
            end
        else
            MacroError('Unable to revert');
    end;


    procedure MakeRoi;
        var
            Left, Top, Width, Height: integer;
            SaveCommand: CommandType;
    begin
        SaveCommand := MacroCommand;
        GetLeftParen;
        left := GetInteger;
        GetComma;
        top := GetInteger;
        GetComma;
        width := GetInteger;
        if width < 1 then
            width := 1;
        GetComma;
        height := GetInteger;
        if height < 1 then
            height := 1;
        GetRightParen;
        KillRoi;
        if token <> DoneT then
            with Info^ do begin
                    StopDigitizing;
                    if SaveCommand = MakeOvalC then
                        RoiType := OvalRoi
                    else
                        RoiType := RectRoi;
                    SetRect(RoiRect, left, top, left + width, top + height);
                    MakeRegion;
                    SetupUndo;
                    RoiShowing := true;
                end;
    end;


    procedure MoveRoi;
        var
            DeltaH, DeltaV: integer;
    begin
        GetLeftParen;
        DeltaH := GetInteger;
        GetComma;
        DeltaV := GetInteger;
        GetRightParen;
        with info^ do begin
                if not RoiShowing then begin
                        MacroError('No Selection');
                        exit(MoveRoi);
                    end;
                OffsetRgn(roiRgn, DeltaH, DeltaV);
                RoiRect := roiRgn^^.rgnBBox;
                RoiUpdateTime := 0;
                MacroOpPending := true;
            end;
    end;


    procedure InsetRoi;
        var
            delta: integer;
    begin
        GetLeftParen;
        delta := GetInteger;
        GetRightParen;
        with info^ do begin
                if not RoiShowing then begin
                        MacroError('No Selection');
                        exit(InsetRoi);
                    end;
                InsetRgn(roiRgn, delta, delta);
                RoiRect := roiRgn^^.rgnBBox;
                RoiUpdateTime := 0;
                MacroOpPending := true;
            end;
    end;


    procedure DoMoveTo; {(x,y:integer)}
    begin
        GetLeftParen;
        CurrentX := GetInteger;
        GetComma;
        CurrentY := GetInteger;
        GetRightParen;
        InsertionPoint.h := CurrentX;
        InsertionPoint.v := CurrentY + 4;
    end;


    procedure DoDrawtext (str: str255; EndOfLine: boolean);
    begin
        if info <> NoInfo then begin
                KillRoi;
                DrawTextString(str, InsertionPoint, TextJust);
                if EndOfLine then begin
                        CurrentY := CurrentY + CurrentSize;
                        InsertionPoint.h := CurrentX;
                        InsertionPoint.v := CurrentY + 4;
                    end;
            end;
    end;


    procedure DrawNumber;
        var
            n: extended;
            str: str255;
            fwidth: integer;
    begin
        GetLeftParen;
        n := GetExpression;
        GetRightParen;
        if token <> DoneT then begin
                if n = trunc(n) then
                    fwidth := 0
                else
                    fwidth := precision;
                RealToString(n, 1, fwidth, str);
                DoDrawText(str, true);
            end;
    end;


    procedure SetFont;
        var
            FontName: str255;
            id: integer;
    begin
        FontName := GetStringArg;
        if Token <> DoneT then begin
                GetFNum(FontName, id);
                if id = 0 then
                    MacroError('Font not available')
                else
                    CurrentFontID := id;
            end;
    end;


    procedure SetFontSize;
        var
            size: integer;
    begin
        GetLeftParen;
        Size := GetInteger;
        GetRightParen;
        if (size < 6) or (size > 720) then
            MacroError('Argument out of range');
        if Token <> DoneT then
            CurrentSize := size;
    end;


    procedure SetText;
        var
            Attributes: str255;
    begin
        Attributes := GetStringArg;
        if Token <> DoneT then begin
                MakeLowerCase(Attributes);
                if pos('with', Attributes) <> 0 then
                    TextBack := WithBack;
                if pos('no', Attributes) <> 0 then
                    TextBack := NoBack;
                if pos('left', Attributes) <> 0 then
                    TextJust := teJustLeft;
                if pos('center', Attributes) <> 0 then
                    TextJust := teJustCenter;
                if pos('right', Attributes) <> 0 then
                    TextJust := teJustRight;
                CurrentStyle := [];
                if pos('bold', Attributes) <> 0 then
                    CurrentStyle := CurrentStyle + [Bold];
                if pos('italic', Attributes) <> 0 then
                    CurrentStyle := CurrentStyle + [Italic];
                if pos('underline', Attributes) <> 0 then
                    CurrentStyle := CurrentStyle + [Underline];
                if pos('outline', Attributes) <> 0 then
                    CurrentStyle := CurrentStyle + [Outline];
                if pos('shadow', Attributes) <> 0 then
                    CurrentStyle := CurrentStyle + [Shadow];
            end;
    end;


    procedure DoPutMessage;
        var
            str: str255;
    begin
        GetArguments(str);
        if Token <> DoneT then
            PutMessage(str)
    end;


    function GetVar: integer;
    begin
        GetVar := 0;
        GetToken;
        if token <> Variable then
            MacroError('Variable expected')
        else
            GetVar := TokenStackLoc;
    end;


    procedure GetPicSize;  {(width,height)}
        var
            loc1, loc2: integer;
    begin
        GetLeftParen;
        loc1 := GetVar;
        GetComma;
        loc2 := GetVar;
        GetRightParen;
        if Token <> DoneT then
            with MacrosP^ do
                if info = NoInfo then begin
                        stack[loc1].value := 0.0;
                        stack[loc2].value := 0.0;
                    end
                else
                    with info^ do begin
                            stack[loc1].value := PixelsPerLine;
                            stack[loc2].value := nLines;
                        end;
    end;


    procedure GetRoi;  {(hloc,vloc,width,height)}
        var
            loc1, loc2, loc3, loc4: integer;
    begin
        GetLeftParen;
        loc1 := GetVar;
        GetComma;
        loc2 := GetVar;
        GetComma;
        loc3 := GetVar;
        GetComma;
        loc4 := GetVar;
        GetRightParen;
        if Token <> DoneT then
            with MacrosP^, Info^ do
                if RoiShowing then
                    with RoiRect do begin
                            stack[loc1].value := left;
                            stack[loc2].value := top;
                            stack[loc3].value := right - left;
                            stack[loc4].value := bottom - top;
                        end
                else begin
                        stack[loc1].value := 0.0;
                        stack[loc2].value := 0.0;
                        stack[loc3].value := 0.0;
                        stack[loc4].value := 0.0;
                    end;
    end;


    procedure CaptureOneFrame;
    begin
        if (FrameGrabber <> QuickCapture) and (FrameGrabber <> ScionLG3) then
            MacroError('Frame grabber not installed')
        else begin
                StartDigitizing;
                CaptureAndDisplayFrame;
                StopDigitizing;
            end;
    end;


    procedure DoMakeNewWindow; {(name:str255)}
        var
            name: str255;
    begin
        GetArguments(name);
        if token <> DoneT then
            if (LongInt(NewPicWidth) * NewPicHeight) > UndoBufSize then
                MacroError('New window larger than Undo buffer')
            else if not NewPicWindow(name, NewPicWidth, NewPicHeight) then
                MacroError('Out of memory');
    end;


    procedure DoSetPalette;
        var
            PaletteType: str255;
            ok: boolean;
    begin
        PaletteType := GetStringArg;
        if token <> DoneT then begin
                MakeLowerCase(PaletteType);
                if pos('gray', PaletteType) <> 0 then
                    ResetGrayMap
                else if pos('pseudo', PaletteType) <> 0 then
                    SwitchColorTables(Pseudo20Item, true)
                else if pos('system', PaletteType) <> 0 then
                    SwitchColorTables(SystemPaletteItem, true)
                else if pos('rainbow', PaletteType) <> 0 then
                    SwitchColorTables(RainbowItem, true)
                else if pos('spectrum', PaletteType) <> 0 then
                    SwitchColorTables(SpectrumItem, true)
            end;
    end;


    procedure DoOpenImage;
        var
            err: OSErr;
            f: integer;
            FileFound, result: boolean;
            fname: str255;
            SaveCommand: CommandType;
    begin
        SaveCommand := MacroCommand;
        GetArguments(fname);
        if token <> DoneT then begin
                if fname = '' then
                    fname := DefaultFileName;
                err := fsopen(fname, DefaultRefNum, f);
                FileFound := err = NoErr;
                err := fsclose(f);
                if FileFound then
                    case SaveCommand of
                        OpenC:
                            result := DoOpen(fname, DefaultRefNum);
                        ImportC:
                            result := ImportFile(fname, DefaultRefNum);
                    end
                else
                    case SaveCommand of
                        OpenC:
                            result := DoOpen('', 0);
                        ImportC:
                            result := ImportFile('', 0);
                    end;
                if result then
                    UpdatePicWindow
                else
                    token := DoneT;
            end;
    end;


    procedure SetImportAttributes;
        var
            Attributes: str255;
    begin
        Attributes := GetStringArg;
        if Token <> DoneT then begin
                MakeLowerCase(Attributes);
                WhatToImport := ImportTIFF;
                ImportCustomDepth := EightBits;
                ImportSwapBytes := false;
                ImportCalibrate := false;
                ImportAll := false;
                ImportAutoScale := true;
                ImportInvert := false;
                if pos('mcid', Attributes) <> 0 then
                    WhatToImport := ImportMCID;
                if pos('look', Attributes) <> 0 then
                    WhatToImport := ImportLUT;
                if pos('palette', Attributes) <> 0 then
                    WhatToImport := ImportLUT;
                if pos('text', Attributes) <> 0 then
                    WhatToImport := ImportText;
                if pos('custom', Attributes) <> 0 then
                    WhatToImport := ImportCustom;
                if (pos('8', Attributes) <> 0) or (pos('eight', Attributes) <> 0) then begin
                        ImportCustomDepth := EightBits;
                        WhatToImport := ImportCustom;
                    end;
                if (pos('signed', Attributes) <> 0) then begin
                        ImportCustomDepth := SixteenBitsSigned;
                        WhatToImport := ImportCustom;
                    end;
                if (pos('unsigned', Attributes) <> 0) then begin
                        ImportCustomDepth := SixteenBitsUnsigned;
                        WhatToImport := ImportCustom;
                    end;
                if (pos('swap', Attributes) <> 0) then
                    ImportSwapBytes := true;
                if (pos('calibrate', Attributes) <> 0) then
                    ImportCalibrate := true;
                if (pos('fixed', Attributes) <> 0) then
                    ImportAutoScale := false;
                if (pos('all', Attributes) <> 0) then
                    ImportAll := true;
                if (pos('invert', Attributes) <> 0) then
                    ImportInvert := true;
            end;
    end;


    procedure SetImportMinMax; {(min,max:integer)}
        var
            TempMin, TempMax: extended;
    begin
        GetLeftParen;
        TempMin := GetExpression;
        GetComma;
        TempMax := GetExpression;
        GetRightParen;
        if Token <> DoneT then begin
                ImportAutoScale := false;
                ImportMin := TempMin;
                ImportMax := TempMax;
            end;
    end;


    procedure SetCustomImport; {(width,height,offset[,nslices]:integer)}
        var
            width, height, nSlices: integer;
            offset: LongInt;
    begin
        GetLeftParen;
        width := GetInteger;
        GetComma;
        height := GetInteger;
        GetComma;
        offset := GetInteger;
        GetToken;
        if token = comma then
            nSlices := GetInteger
        else begin
                PutTokenBack;
                nSlices := 1
            end;
        GetRightParen;
        if (width < 0) or (width > MaxPicSize) or (height < 0) or (offset < 0) or (nSlices < 1) then
            MacroError('Argument out of range');
        if Token <> DoneT then begin
                ImportCustomWidth := width;
                ImportCustomHeight := height;
                ImportCustomOffset := offset;
                ImportCustomSlices := nSlices;
                WhatToImport := ImportCustom;
            end;
    end;


    procedure SelectImage (id: integer);
    begin
        StopDigitizing;
        SaveRoi;
        DisableDensitySlice;
        SelectWindow(PicWindow[id]);
        Info := pointer(WindowPeek(PicWindow[id])^.RefCon);
        ActivateWindow;
        GenerateValues;
        LoadLUT(info^.cTable);
        UpdatePicWindow;
    end;


    procedure SelectPic; {(PicN:integer)}
        var
            PicN, i: integer;
            SaveCommand: CommandType;
    begin
        SaveCommand := MacroCommand;
        GetLeftParen;
        PicN := GetInteger;
        GetRightParen;
        i := 0;
        while (PicN < 0) and (i < nPics) do begin
                i := i + 1;
                if InfoPtr(WindowPeek(PicWindow[i])^.RefCon)^.pidNum = PicN then
                    PicN := i;
            end;
        if (PicN < 1) or (PicN > nPics) then
            MacroError('Specified image does not exist');
        if Token <> DoneT then begin
                if SaveCommand = SelectPicC then
                    SelectImage(PicN)
                else
                    Info := pointer(WindowPeek(PicWindow[PicN])^.RefCon);
            end;
    end;


    procedure SetPicName;  {(name:string)}
        var
            n, i: LongInt;
            isInteger: boolean;
            name: str255;
    begin
        GetArguments(name);
        if Token <> DoneT then begin
                with info^ do begin
                        title := name;
                        if PictureType <> FrameGrabberType then
                            PictureType := NewPicture;
                        UpdateWindowsMenuItem(PixMapSize, title, PicNum);
                        UpdateTitleBar;
                    end;
            end;
    end;


    procedure SetNewSize; {(width,height:integer)}
        var
            TempWidth, TempHeight: integer;
    begin
        GetLeftParen;
        TempWidth := GetInteger;
        GetComma;
        TempHeight := GetInteger;
        GetRightParen;
        if Token <> DoneT then begin
                NewPicWidth := TempWidth;
                NewPicHeight := TempHeight;
                if odd(NewPicWidth) then
                    NewPicWidth := NewPicWidth + 1;
                if NewPicWidth > MaxPicSize then
                    NewPicWidth := MaxPicSize;
                if NewPicWidth < 8 then
                    NewPicWidth := 8;
                if NewPicHeight < 8 then
                    NewPicHeight := 8;
                if NewPicHeight > MaxPicSize then
                    NewPicHeight := MaxPicSize;
            end;
    end;


    procedure DoSaveAs;
        var
            name: str255;
            RefNum: integer;
            HasArgs: boolean;
    begin
        name := info^.title;
        if (name = 'Untitled') or (name = 'Camera') then
            name := '';
        GetToken;
        HasArgs := token = LeftParen;
        PutTokenBack;
        if HasArgs then
            GetArguments(name);
        if token <> DoneT then begin
                StopDigitizing;
                if nSaves = 0 then
                    RefNum := 0
                else
                    RefNum := DefaultRefNum;
                case CurrentWindow of
                    TextKind:
                        SaveTextAs;
                    ResultsKind:
                        Export('', RefNum);
                    otherwise begin
                            if info <> NoInfo then
                                SaveAs(name, RefNum)
                            else
                                MacroError(NoImageOpen);
                        end;
                end;
                nSaves := nSaves + 1;
            end;
    end;


    procedure DoSave;
        var
            kind: integer;
    begin
        StopDigitizing;
        kind := CurrentWindow;
        if (kind = PicKind) or (kind = TextKind) or (Kind = ResultsKind) then
            SaveFile
        else
            MacroError('Nothing to save');
    end;


    procedure DoExport;
        var
            name: str255;
            RefNum: integer;
            HasArgs: boolean;
    begin
        StopDigitizing;
        name := info^.title;
        if (name = 'Untitled') or (name = 'Camera') then
            name := '';
        GetToken;
        HasArgs := token = LeftParen;
        PutTokenBack;
        if HasArgs then
            GetArguments(name);
        if nSaves = 0 then
            RefNum := 0
        else
            RefNum := DefaultRefNum;
        Export(name, RefNum);
        nSaves := nSaves + 1;
    end;


    procedure DoCopyResults;
        var
            IgnoreResult: boolean;
    begin
        if mCount < 1 then
            MacroError('Copy Results failed')
        else begin
                CopyResults;
                IgnoreResult := SystemEdit(3); {Fake Copy needed for MultiFinder}
            end;
    end;


    procedure DisposeAll;
        var
            i, ignore: integer;
    begin
        StopDigitizing;
        for i := nPics downto 1 do begin
                Info := pointer(WindowPeek(PicWindow[i])^.RefCon);
                ignore := CloseAWindow(info^.wptr);
            end;
    end;


    procedure DoDuplicate;
        var
            str: str255;
    begin
        GetArguments(str);
        if token <> DoneT then
            if not Duplicate(str, false) then
                token := DoneT
            else
                UpdatePicWindow;
    end;


    procedure DoLineTo; {(x,y:integer)}
        var
            x, y: integer;
            p1, p2: point;
    begin
        GetLeftParen;
        p2.h := GetInteger;
        GetComma;
        p2.v := GetInteger;
        GetRightParen;
        if token <> DoneT then begin
                KillRoi;
                p1.h := CurrentX;
                p1.v := CurrentY;
                CurrentX := p2.h;
                CurrentY := p2.v;
                OffscreenToScreen(p1);
                OffscreenToScreen(p2);
                DrawObject(LineObj, p1, p2);
            end;
    end;


    procedure DoGetLine;  {(var x1,y1,x2,y2:real; LineWidth:integer)}
        var
            loc1, loc2, loc3, loc4, loc5: integer;
            x1, y1, x2, y2: real;
    begin
        GetLeftParen;
        loc1 := GetVar;
        GetComma;
        loc2 := GetVar;
        GetComma;
        loc3 := GetVar;
        GetComma;
        loc4 := GetVar;
        GetComma;
        loc5 := GetVar;
        GetRightParen;
        if Token <> DoneT then
            with MacrosP^, info^ do begin
                    GetLoi(x1, y1, x2, y2);
                    if RoiShowing and (RoiType = LineRoi) then
                        stack[loc1].value := x1
                    else
                        stack[loc1].value := -1;
                    stack[loc2].value := y1;
                    stack[loc3].value := x2;
                    stack[loc4].value := y2;
                    stack[loc5].value := LineWidth;
                end;
    end;


    procedure DoScaleAndRotate; {(hscale,vscale,angle:real)}
        var
            SaveCommand: CommandType;
    begin
        SaveCommand := MacroCommand;
        GetLeftParen;
        rsHScale := GetExpression;
        GetComma;
        rsVScale := GetExpression;
        if SaveCommand <> ScaleSelectionC then begin
                GetComma;
                rsAngle := GetExpression;
            end;
        GetRightParen;
        if token <> DoneT then begin
                if SaveCommand = ScaleSelectionC then begin
                        rsMethod := NearestNeighbor;
                        rsCreateNewWindow := false;
                        rsAngle := 0.0;
                    end;
                ScaleAndRotate;
            end;
    end;


    procedure SetPlotScale; {(min,max:integer)}
        var
            min, max: extended;
    begin
        GetLeftParen;
        min := GetExpression;
        GetComma;
        max := GetExpression;
        GetRightParen;
        if not info^.DensityCalibrated then begin
                RangeCheck(trunc(min));
                RangeCheck(trunc(max));
            end;
        if token <> DoneT then begin
                AutoScalePlots := (min = 0.0) and (max = 0.0);
                ProfilePlotMin := min;
                ProfilePlotMax := max;
            end;
    end;


    procedure SetPlotDimensions; {(width,height:integer)}
        var
            width, height: integer;
    begin
        GetLeftParen;
        width := GetInteger;
        GetComma;
        height := GetInteger;
        GetRightParen;
        if token <> DoneT then begin
                FixedSizePlot := not ((width = 0) and (height = 0));
                ProfilePlotWidth := width;
                ProfilePlotHeight := height;
            end;
    end;


    procedure GetResults;  {(var n,mean,mode,min,max:real)}
        var
            loc1, loc2, loc3, loc4, loc5: integer;
    begin
        GetLeftParen;
        loc1 := GetVar;
        GetComma;
        loc2 := GetVar;
        GetComma;
        loc3 := GetVar;
        GetComma;
        loc4 := GetVar;
        GetComma;
        loc5 := GetVar;
        GetRightParen;
        if mCount = 0 then
            MacroError('No results');
        if Token <> DoneT then
            with MacrosP^, results do begin
                    stack[loc1].value := PixelCount^[mCount];
                    stack[loc2].value := UncalibratedMean;
                    stack[loc3].value := imode;
                    stack[loc4].value := MinIndex;
                    stack[loc5].value := MaxIndex;
                end;
    end;


    procedure DoPasteOperation;
    begin
        if not (OpPending and (CurrentOp = PasteOp)) then begin
                MacroError('Not pasting');
                exit(DoPasteOperation);
            end;
        if MacroCommand in [AddC, SubC, MulC, DivC] then begin
                case MacroCommand of
                    AddC:
                        CurrentOp := AddOp;
                    SubC:
                        CurrentOp := SubtractOp;
                    MulC:
                        CurrentOp := MultiplyOp;
                    DivC:
                        CurrentOp := DivideOp;
                end;
                DoPasteMath;
                exit(DoPasteOperation);
            end;
        case MacroCommand of
            CopyModeC:
                SetPasteMode(CopyModeItem);
            AndC:
                SetPasteMode(AndItem);
            OrC:
                SetPasteMode(OrItem);
            XorC:
                SetPasteMode(XorItem);
            ReplaceC:
                SetPasteMode(ReplaceItem);
            BlendC:
                SetPasteMode(BlendItem);
        end;
        if OptionKeyWasDown then begin
                if PasteControl <> nil then
                    DrawPasteControl;
            end
        else
            KillRoi;
    end;


    procedure SetWidth; {(width:integer)}
        var
            width: integer;
    begin
        GetLeftParen;
        width := GetInteger;
        GetRightParen;
        if (Token <> DoneT) and (width > 0) then begin
                LineWidth := width;
                ShowLIneWidth;
            end;
    end;


    function GetMType (index: integer): MeasurementTypes;
    begin
        case index of
            0:
                GetMType := AreaM;
            1:
                GetMType := MeanM;
            2:
                GetMType := StdDevM;
            3:
                GetMType := xyLocM;
            4:
                GetMType := ModeM;
            5:
                GetMType := LengthM;
            6:
                GetMType := MajorAxisM;
            7:
                GetMType := MinorAxisM;
            8:
                GetMType := AngleM;
            9:
                GetMType := IntDenM;
            10:
                GetMType := MinMaxM;
            11:
                GetMType := User1M;
            12:
                GetMType := User2M;
        end;
    end;


    procedure SetPrecision; {(DigitsRightofDecimalPoint[,FieldWidth]:integer)}
        var
            digits, width: LongInt;
    begin
        GetLeftParen;
        digits := GetInteger;
        GetToken;
        if token = comma then
            width := GetInteger
        else
            PutTokenBack;
        GetRightParen;
        if Token <> DoneT then begin
                if (digits >= 0) and (digits <= 12) then
                    precision := digits;
                if (width >= 1) and (width <= 18) then
                    FieldWidth := width;
            end;
    end;


    procedure SetParticleSize; {(min,max:LongInt)}
        var
            min, max: LongInt;
    begin
        GetLeftParen;
        min := GetInteger;
        GetComma;
        max := GetInteger;
        GetRightParen;
        if Token <> DoneT then begin
                MinParticleSize := min;
                MaxParticleSize := max;
            end;
    end;


    procedure SetThreshold; {(level:integer)}
        var
            level: LongInt;
    begin
        GetLeftParen;
        level := GetInteger;
        GetRightParen;
        if level = -1 then begin
                DisableThresholding;
                exit(SetThreshold);
            end;
        RangeCheck(level);
        if Token <> DoneT then
            EnableThresholding(level);
    end;


    procedure DoPutPixel; {(hloc,vloc, value:integer)}
        var
            hloc, vloc, value: integer;
            MaskRect: rect;
    begin
        GetLeftParen;
        hloc := GetInteger;
        GetComma;
        vloc := GetInteger;
        GetComma;
        value := GetInteger;
        GetRightParen;
        if (Token <> DoneT) and (info <> NoInfo) then begin
                KillRoi;
                PutPixel(hloc, vloc, value);
                SetRect(MaskRect, hloc, vloc, hloc + 1, vloc + 1);
                UpdateScreen(MaskRect);
            end;
    end;


    procedure CloseWindow;
        var
            OldPicNum, NewPicNum, ignore: integer;
    begin
        if CurrentWindow <> PicKind then begin
                ignore := CloseAWindow(CurrentWPtr);
                exit(CloseWindow);
            end;
        if info = NoInfo then begin
                MacroError(NoImageOpen);
                exit(CloseWindow);
            end;
        StopDigitizing;
        SaveRoi;
        with info^ do begin
                OldPicNum := PicNum;
                ignore := CloseAWindow(wptr);
            end;
        if nPics >= 1 then begin
                NewPicNum := OldPicNum - 1;
                if NewPicNum < 1 then
                    NewPicNum := 1;
                SelectImage(NewPicNum);
            end;
    end;


    procedure SetScaling;
        var
            ScalingOptions: str255;
            ok: boolean;
    begin
        ScalingOptions := GetStringArg;
        if token <> DoneT then begin
                MakeLowerCase(ScalingOptions);
                rsInteractive := false;
                if pos('bilinear', ScalingOptions) <> 0 then
                    rsMethod := Bilinear;
                if pos('nearest', ScalingOptions) <> 0 then
                    rsMethod := NearestNeighbor;
                if pos('new', ScalingOptions) <> 0 then
                    rsCreateNewWindow := true;
                if pos('same', ScalingOptions) <> 0 then
                    rsCreateNewWindow := false;
                if pos('interactive', ScalingOptions) <> 0 then
                    rsInteractive := true;
            end;
    end;


    procedure DoChangeValues; {(v1,v2,v3:integer)}
        var
            v1, v2, v3: integer;
    begin
        GetLeftParen;
        v1 := GetInteger;
        GetComma;
        v2 := GetInteger;
        GetComma;
        v3 := GetInteger;
        GetRightParen;
        RangeCheck(v1);
        RangeCheck(v2);
        RangeCheck(v3);
        if Token <> DoneT then
            ChangeValues(v1, v2, v3);
    end;


    procedure DoGetMouse;  {(var x,y:integer)}
        var
            loc1, loc2, sh, sv: integer;
            loc: point;
    begin
        GetLeftParen;
        loc1 := GetVar;
        GetComma;
        loc2 := GetVar;
        GetRightParen;
        if Token <> DoneT then
            with MacrosP^ do begin
                    SetPort(info^.wptr);
                    GetMouse(loc);
                    with loc do begin
                            sh := h;
                            sv := v;
                            ScreenToOffscreen(loc);
                            if sh < 0 then
                                h := sh;
                            if sv < 0 then
                                v := sv;
                            stack[loc1].value := h;
                            stack[loc2].value := v;
                        end;
                end;
    end;


    procedure DoRotate (cmd: CommandType);
        var
            NoBoolean, NewWindow: boolean;
    begin
        GetToken;
        noBoolean := token <> LeftParen;
        PutTokenBack;
        if NoBoolean then
            NewWindow := false
        else
            NewWindow := GetBooleanArg;
        if NewWindow then begin
                case cmd of
                    RotateRC:
                        RotateToNewWindow(RotateRight);
                    RotateLC:
                        RotateToNewWindow(RotateLeft)
                end;
                if not macro then
                    MacroError('Rotate failed')
            end
        else
            case cmd of
                RotateRC:
                    FlipOrRotate(RotateRight);
                RotateLC:
                    FlipOrRotate(RotateLeft)
            end;
    end;


    procedure DoSelectSlice; {(SliceNumber:integer)}
        var
            SliceNumber: LongInt;
            isRoi: boolean;
            SaveCommand: CommandType;
    begin
        SaveCommand := MacroCommand;
        GetLeftParen;
        SliceNumber := GetInteger;
        GetRightParen;
        with info^, info^.StackInfo^ do begin
                if (SliceNumber < 1) or (SliceNumber > nSlices) then
                    MacroError('Illegal slice number');
                if Token <> DoneT then begin
                        isRoi := RoiShowing;
                        if isRoi then
                            KillRoi;
                        CurrentSlice := SliceNumber;
                        SelectSlice(CurrentSlice);
                        if SaveCommand = SelectSliceC then begin
                                UpdatePicWindow;
                                UpdateTitleBar;
                            end;
                        if isRoi then
                            RestoreRoi;
                    end;
            end;
    end;


    procedure MakeNewStack; {(name:str255)}
        var
            name: str255;
            aok: boolean;
    begin
        GetArguments(name);
        if token <> DoneT then
            if (LongInt(NewPicWidth) * NewPicHeight) > UndoBufSize then
                MacroError('Stack larger than Undo Buffer')
            else if NewPicWindow(name, NewPicWidth, NewPicHeight) then
                if not MakeStackFromWindow then
                    MacroError('Out of memory');
    end;


    procedure MakeLineRoi; {(x1,y1,x2,y2:real)}
        var
            x1, y1, x2, y2: real;
    begin
        GetLeftParen;
        x1 := GetExpression;
        GetComma;
        y1 := GetExpression;
        GetComma;
        x2 := GetExpression;
        GetComma;
        y2 := GetExpression;
        GetRightParen;
        if token <> DoneT then
            with Info^ do begin
                    KillRoi;
                    StopDigitizing;
                    LX1 := x1;
                    LY1 := y1;
                    LX2 := x2;
                    LY2 := y2;
                    RoiType := LineRoi;
                    MakeRegion;
                    SetupUndo;
                    RoiShowing := true;
                end;
    end;


    procedure DoGetTime;
        var
            date: DateTimeRec;
            loc1, loc2, loc3, loc4, loc5, loc6, loc7: integer;
    begin
        GetLeftParen;
        loc1 := GetVar;
        GetComma;
        loc2 := GetVar;
        GetComma;
        loc3 := GetVar;
        GetComma;
        loc4 := GetVar;
        GetComma;
        loc5 := GetVar;
        GetComma;
        loc6 := GetVar;
        GetComma;
        loc7 := GetVar;
        GetRightParen;
        if Token <> DoneT then
            with MacrosP^, info^ do begin
                    GetTime(date);
                    with date do begin
                            stack[loc1].value := year;
                            stack[loc2].value := month;
                            stack[loc3].value := day;
                            stack[loc4].value := hour;
                            stack[loc5].value := minute;
                            stack[loc6].value := second;
                            stack[loc7].value := DayOfWeek;
                        end;
                end;
    end;


    procedure DoSetScale; {(scale:real; unit:string)}
        var
            id: integer;
            scale: extended;
            str: str255;
    begin
        GetLeftParen;
        scale := GetExpression;
        GetComma;
        str := GetString;
        GetRightParen;
        if token <> DoneT then
            with info^ do begin
                    if str = '' then begin
                            SetScale; {Display Set Scale dialog box}
                            exit(DoSetScale);
                        end;
                    if scale < 0.0 then begin
                            MacroError('Scale<0');
                            exit(DoSetScale);
                        end;
                    MakeLowerCase(str);
                    xUnit := str;
                    xSpatialScale := scale;
                    ySpatialScale := scale;
                    PixelAspectRatio := 1.0;
                    SpatiallyCalibrated := (xUnit <> '') and (xUnit <> 'pixel') and (xUnit <> 'pixels') and (xSpatialScale <> 0.0);
                    UpdateTitleBar;
                end;
    end;


    procedure SaveState;
    begin
        SaveForeground := ForegroundIndex;
        SaveBackground := BackgroundIndex;
        SavePicWidth := NewPicWidth;
        SavePicHeight := NewPicHeight;
        SaveMethod := rsMethod;
        SaveCreate := rsCreateNewWindow;
        SaveAngle := rsAngle;
        SaveH := rsHScale;
        SaveV := rsVScale;
        SaveInvertY := InvertYCoordinates;
        SaveScaleArithmetic := ScaleArithmetic;
        SaveScaleConvolutions := ScaleConvolutions;
    end;


    procedure RestoreState;
    begin
        if SaveForeground = -1 then
            MacroError('State not saved')
        else begin
                SetForegroundColor(SaveForeground);
                SetBackgroundColor(SaveBackground);
                NewPicWidth := SavePicWidth;
                NewPicHeight := SavePicHeight;
                rsMethod := SaveMethod;
                rsCreateNewWindow := SaveCreate;
                rsAngle := SaveAngle;
                rsHScale := SaveH;
                rsVScale := SaveV;
                InvertYCoordinates := SaveInvertY;
                ScaleArithmetic := SaveScaleArithmetic;
                ScaleConvolutions := SaveScaleConvolutions;
            end;
    end;


    procedure DoPrint;
    begin
        FindWhatToPrint;
        if WhatToPrint <> NothingToPrint then
            Print(false)
        else
            MacroError('NothingToPrint');
    end;


    procedure SetCounter; {(n:integer)}
        var
            N, i: LongInt;
    begin
        GetLeftParen;
        N := GetInteger;
        GetRightParen;
        if (N < 0) or (N > MaxMeasurements) then
            MacroError('Argument out of range');
        if Token <> DoneT then begin
                if N = 0 then
                    ResetCounter;
                for i := mCount + 1 to N do
                    ClearResults(i);
                mCount := N;
                UpdateList;
                ShowValues;
            end;
    end;


    procedure OutputText;
        var
            NewLine: boolean;
            str: str255;
            i: integer;
            SaveCommand: CommandType;
    begin
        NewLine := MacroCommand <> WriteC;
        SaveCommand := MacroCommand;
        GetArguments(str);
        if token <> DoneT then begin
                if SaveCommand = ShowMsgC then begin
                        for i := 1 to length(str) do
                            if str[i] = '\' then
                                str[i] := cr;
                        ValuesMessage := str;
                        ShowValues;
                    end
                else begin
                        if CurrentWindow = TextKind then
                            InsertText(str, NewLine)
                        else
                            DoDrawText(str, NewLine);
                    end;
            end;
    end;


    procedure SetErosionDilationCount; {(n:integer)}
        var
            n: LongInt;
    begin
        GetLeftParen;
        n := GetInteger;
        GetRightParen;
        if (n < 1) or (n > 8) then
            MacroError('Argument out of range');
        if Token <> DoneT then begin
                BinaryCount := n;
                BinaryThreshold := BinaryCount * 255;
            end;
    end;


    procedure SetSliceSpacing; {(n:real)}
        var
            n: real; {pixels}
    begin
        GetLeftParen;
        n := GetExpression;
        GetRightParen;
        if (n <= 0.0) or (n > 100.0) then
            MacroError('Argument out of range');
        if info^.StackInfo = nil then
            MacroError('No stack');
        if Token <> DoneT then
            info^.StackInfo^.SliceSpacing := n;
    end;


    procedure GetOrPutLineOrColumn;  {(x,y,count:integer:integer)}
        var
            x, y, count, i: integer;
            MaskRect: rect;
            aLine2: LineType;
    begin
        GetLeftParen;
        x := GetInteger;
        GetComma;
        y := GetInteger;
        GetComma;
        count := GetInteger;
        GetRightParen;
        if (Token <> DoneT) and (count <= MaxLine) then
            with MacrosP^ do begin
                    KillRoi;
                    case MacroCommand of
                        GetRowC:
                            GetLine(x, y, count, aLine);
                        PutRowC:  begin
                                PutLine(x, y, count, aLine);
                                SetRect(MaskRect, x, y, x + count, y + 1);
                                UpdateScreen(MaskRect);
                                info^.changes := true;
                            end;
                        GetColumnC:
                            GetColumn(x, y, count, aLine);
                        PutColumnC:  begin
                                PutColumn(x, y, count, aLine);
                                SetRect(MaskRect, x, y, x + 1, y + count);
                                UpdateScreen(MaskRect);
                                info^.changes := true;
                            end;
                    end; {case}
                end;
    end;


    procedure CheckVersion; {(RequiredVersion:real)}
        var
            RequiredVersion: real;
            str: str255;
    begin
        GetLeftParen;
        RequiredVersion := GetExpression;
        GetRightParen;
        if (Token <> DoneT) then
            if round(RequiredVersion * 100.0) > version then begin
                    RealToString(RequiredVersion, 1, 2, str);
                    PutMessage(concat('This macro requires version ', str, ' or later of Image.'));
                    Token := DoneT;
                end;
    end;


    procedure SetOptions; {(Options:string)}
        var
            options: str255;
            mtype: MeasurementTypes;
            i, LastOption: integer;
            SaveMeasurements: set of MeasurementTypes;
    begin
        GetLeftParen;
        Options := GetString;
        GetRightParen;
        if (Token <> DoneT) then begin
                SaveMeasurements := measurements;
                MakeLowerCase(options);
                Measurements := [];
                if pos('area', options) <> 0 then
                    Measurements := Measurements + [AreaM];
                if pos('mean', options) <> 0 then
                    Measurements := Measurements + [MeanM];
                if pos('st', options) <> 0 then
                    Measurements := Measurements + [StdDevM];
                if pos('center', options) <> 0 then
                    Measurements := Measurements + [xyLocM];
                if pos('mode', options) <> 0 then
                    Measurements := Measurements + [ModeM];
                if (pos('per', options) <> 0) or (pos('length', options) <> 0) then
                    Measurements := Measurements + [LengthM];
                if pos('major', options) <> 0 then
                    Measurements := Measurements + [MajorAxisM];
                if pos('minor', options) <> 0 then
                    Measurements := Measurements + [MinorAxisM];
                if pos('angle', options) <> 0 then
                    Measurements := Measurements + [AngleM];
                if pos('int', options) <> 0 then
                    Measurements := Measurements + [IntDenM];
                if pos('max', options) <> 0 then
                    Measurements := Measurements + [MinMaxM];
                if pos('1', options) <> 0 then
                    Measurements := Measurements + [User1M];
                if pos('2', options) <> 0 then
                    Measurements := Measurements + [User2M];
                UpdateFitEllipse;
                if Measurements <> SaveMeasurements then
                    UpdateList;
            end;
    end;


    procedure SetLabel;
        var
            SaveCommand: CommandType;
            str, SaveLabel: str255;
    begin
        SaveCommand := MacroCommand;
        GetArguments(str);
        case SaveCommand of
            SetMajorC:  begin
                    SaveLabel := MajorLabel;
                    MajorLabel := str;
                    Measurements := Measurements + [MajorAxisM];
                end;
            SetMinorC:  begin
                    SaveLabel := MinorLabel;
                    MinorLabel := str;
                    Measurements := Measurements + [MinorAxisM];
                end;
            SetUser1C:  begin
                    SaveLabel := User1Label;
                    User1Label := str;
                    Measurements := Measurements + [User1M];
                end;
            SetUser2C:  begin
                    SaveLabel := User2Label;
                    User2Label := str;
                    Measurements := Measurements + [User2M];
                end;
        end; {case}
        ShowValues;
        if str <> SaveLabel then
            UpdateList;
    end;


    procedure DoUpdateLUT;
    begin
        with info^ do begin
                LoadLUT(ctable);
                IdentityFunction := false;
                if isGrayScaleLUT then
                    LutMode := CustomGrayScale
                else begin
                        SetupPseudocolor;
                        LutMode := PseudoColor;
                    end;
                UpdateMap;
            end;
    end;


    procedure SubtractBackground; {(Options:string; BallRadius:integer)}
        var
            options: str255;
            radius, item: integer;
    begin
        GetLeftParen;
        Options := GetString;
        GetComma;
        radius := GetInteger;
        GetRightParen;
        if (Token <> DoneT) then begin
                MakeLowerCase(options);
                FasterBackgroundSubtraction := pos('faster', options) <> 0;
                item := Sub2DItem;
                if pos('hor', options) <> 0 then
                    item := HorizontalItem;
                if pos('ver', options) <> 0 then
                    item := VerticalItem;
                if pos('roll', options) <> 0 then
                    item := Sub2DItem;
                if pos('remove', options) <> 0 then
                    item := RemoveStreaksItem;
            end;
        BallRadius := Radius;
        if Radius < 1 then
            BallRadius := 1;
        if Radius > 319 then
            BallRadius := 319;
        DoBackgroundMenuEvent(Item);
    end;


    procedure SetExportMode;
        var
            mode: str255;
    begin
        mode := GetStringArg;
        if Token <> DoneT then begin
                MakeLowerCase(mode);
                ExportAsWhat := AsRaw;
                if pos('mcid', mode) <> 0 then
                    ExportAsWhat := asMCID;
                if pos('text', mode) <> 0 then
                    ExportAsWhat := asText;
                if pos('lut', mode) <> 0 then
                    ExportAsWhat := asLUT;
                if pos('meas', mode) <> 0 then
                    ExportAsWhat := asMeasurements;
                if pos('plot', mode) <> 0 then
                    ExportAsWhat := asPlotValues;
                if pos('hist', mode) <> 0 then
                    ExportAsWhat := asHistogramValues;
                if pos('xy', mode) <> 0 then
                    ExportAsWhat := asCoordinates;
            end;
    end;


    procedure MoveCurrentWindow;{(x,y:integer)}
        var
            x, y: integer;
            ignore: integer;
            fwptr: WindowPtr;
            kind: integer;
    begin
        GetLeftParen;
        x := GetInteger;
        GetComma;
        y := GetInteger;
        GetRightParen;
        fwptr := FrontWindow;
        if fwptr <> nil then begin
                kind := WindowPeek(fwptr)^.WindowKind;
                if (kind = PicKind) or (kind = ProfilePlotKind) or (kind = CalibrationPlotKind) or (kind = HistoKind) or (Kind = PasteControlKind) or (Kind = ResultsKind) or (Kind = TextKind) then
                    MoveWindow(fwptr, x, y, true);
            end;
    end;


    procedure DoUserCode; {str:str255; Param1,Param2,Param3:real;}
  {Contributed by Mark Vivino}
        var
            WhichCode: integer;
            Param1, Param2, Param3: extended;
            str: str255;
            NewVersion: boolean;
    begin
        GetLeftParen;
        GetToken;
        NewVersion := (token = StringLiteral) or (token = StringVariable);
        PutTokenBack;
        WhichCode := 0;
        str := '';
        if NewVersion then
            str := GetString
        else
            WhichCode := GetInteger;
        GetComma;
        Param1 := GetExpression;
        GetComma;
        Param2 := GetExpression;
        GetComma;
        Param3 := GetExpression;
        GetRightParen;
        if Token <> DoneT then begin
                if NewVersion then
                    UserMacroCode(str, Param1, Param2, Param3)
                else begin
                        if (WhichCode < 1) or (WhichCode > 10) then
                            MacroError('Range error . Allowable range is 1 to 10.');
                        OldUserMacroCode(WhichCode, Param1, Param2, Param3);
                    end;
            end;
    end;


    procedure CloseSerialPorts;
        var
            err: OSErr;
    begin
        if SerialBufferP <> nil then begin
                err := CloseDriver(SerialOut);
                err := CloseDriver(SerialIn);
                DisposePtr(SerialBufferP);
            end;
    end;


    procedure OpenSerial;
        const
            SerialBufferSize = 1024;
        var
            err: OSErr;
            baud, data, stop, parity: integer;
            config: integer;
            flags: SerShk;
            str: str255;
    begin
        CloseSerialPorts;
        baud := baud9600;
        data := data8;
        stop := stop10;
        parity := noParity;
        str := GetStringArg;
        if token = DoneT then
            exit(OpenSerial);
        MakeLowerCase(str);
        if pos('300', str) <> 0 then
            baud := baud300;
        if pos('1200', str) <> 0 then
            baud := baud1200;
        if pos('2400', str) <> 0 then
            baud := baud2400;
        if pos('19200', str) <> 0 then
            baud := baud19200;
        if pos('two', str) <> 0 then
            stop := stop20;
        if pos('odd', str) <> 0 then
            parity := oddParity;
        if pos('even', str) <> 0 then
            parity := evenParity;
        if pos('seven', str) <> 0 then
            data := data7;
        if (OpenDriver('.AOut', SerialOut) <> NoErr) or (OpenDriver('.AIn', SerialIn) <> NoErr) then begin
                MacroError('Error opening modem port');
                exit(OpenSerial);
            end;
        SerialBufferP := NewPtr(SerialBufferSize);
        if SerialBufferP = nil then begin
                MacroError('Out of Memory');
                exit(OpenSerial);
            end;
        with flags do begin
                fXOn := ord(false); {Disable xon/xoff output flow control}
                fCTS := ord(false); {Disable CTS (output) flow control}
                xOn := chr(17);
                xOff := chr(19);
                errs := 0;
                evts := 0;
                fInX := ord(true);  {Enable xon/xoff input flow control}
                fDTR := ord(true); {Enable DTR (input) flow control}
            end;
        Config := baud + data + stop + parity;
        Err := SerHShake(SerialOut, flags);
        Err := SerSetBuf(SerialIn, SerialBufferP, SerialBufferSize);
        Err := SerReset(SerialOut, Config);
    end;


    procedure PutSerial;
        var
            i: integer;
            Size: LongInt;
            OutputBuffer: packed array[1..256] of char;
            str: str255;
            err: OSErr;
    begin
        GetArguments(str);
        if token = DoneT then
            exit(PutSerial);
        if SerialBufferP = nil then begin
                MacroError('Serial port not open');
                exit(PutSerial);
            end;
        Size := 0;
        for i := 1 to length(str) do begin
                size := size + 1;
                OutputBuffer[size] := str[i];
            end;
        if size > 0 then
            err := fswrite(SerialOut, size, @OutputBuffer);
    end;


    procedure DoSetCursor; {str: string}
        var
            str: str255;
    begin
        str := GetStringArg;
        if Token <> DoneT then begin
                MakeLowerCase(str);
                if pos('watch', str) <> 0 then
                    SetCursor(watch);
                if pos('cross', str) <> 0 then
                    SetCursor(ToolCursor[SelectionTool]);
                if pos('arrow', str) <> 0 then
                    InitCursor;
            end;
    end;


    procedure SetVideoOptions; {options: string}
        var
            options: str255;
            NewSyncMode: SyncModeType;

        procedure SetOption (id: integer; var option: boolean; enable: boolean);
    {Updates the modeless Video Control dialog box.}
        begin
            if option <> enable then
                DoVideoControl(id)
        end;

    begin
        options := GetStringArg;
        if Token <> DoneT then begin
                MakeLowerCase(options);
                SetOption(InvertID, InvertVideo, pos('invert', options) <> 0);
                SetOption(HighlightID, HighlightSaturatedPixels, pos('high', options) <> 0);
                SetOption(OscillatingID, OscillatingMovies, pos('osc', options) <> 0);
                SetOption(TriggerID, ExternalTrigger, pos('trig', options) <> 0);
                SetOption(BlindID, BlindMovieCapture, pos('blind', options) <> 0);
                if pos('sep', options) <> 0 then
                    NewSyncMode := SeparateSync
                else
                    NewSyncMode := NormalSync;
                if NewSyncMode <> SyncMode then
                    DoVideoControl(SyncID)
            end;
    end;


    procedure SetChannel; {(channel:integer)}
        var
            channel: integer;
    begin
        GetLeftParen;
        channel := GetInteger;
        GetRightParen;
        if (channel < 1) or (channel > 4) then
            MacroError('Bad channel number')
        else
            DoVideoControl(FirstChannelID + channel - 1);
    end;


    procedure DoAcquire;
        var
            fname: str255;
    begin
        fname := GetStringArg;
        LoadAcqPlugIn(fname);
    end;


    procedure DoFilter;
        var
            fname: str255;
    begin
        fname := GetStringArg;
        LoadFilterPlugIn(fname);
    end;


    procedure DoPhotoMode;
        var
            erase: boolean;
    begin
        erase := GetBooleanArg;
        if Token <> DoneT then begin
                if erase then begin
                        EraseScreen;
                        UpdatePicWindow;
                        InPhotoMode := true;
                    end
                else if InPhotoMode then begin
                        RestoreScreen;
                        InitCursor;
                    end;
            end;
    end;


    procedure RGBToIndexed; {options: string}
        var
            options: str255;
    begin
        options := GetStringArg;
        if Token <> DoneT then begin
                MakeLowerCase(options);
                RGBLut := CustomLUT;
                DitherColor := false;
                if pos('exist', options) <> 0 then
                    RGBLut := ExistingLUT;
                if pos('system', options) <> 0 then
                    RGBLut := SystemLUT;
                if pos('dither', options) <> 0 then
                    DitherColor := true;
                ConvertRGBToEightBitColor(false);
            end;
    end;


    procedure DoAverageFrames; {[(Options:string; nFrames:integer)]}
        var
            options: str255;
            nFrames: integer;
            HasArguments: boolean;
    begin
        GetToken;
        HasArguments := token = LeftParen;
        PutTokenBack;
        if HasArguments then begin
                GetLeftParen;
                Options := GetString;
                GetComma;
                nFrames := GetInteger;
                if nFrames > 0 then
                    FramesToAverage := nFrames;
                GetRightParen;
                if (Token <> DoneT) then begin
                        MakeLowerCase(options);
                        VideoRateAveraging := false;
                        SumFrames := false;
                        if (pos('int', options) <> 0) or (pos('sum', options) <> 0) then
                            sumFrames := true;
                        if pos('video', options) <> 0 then
                            VideoRateAveraging := true;
                    end;
            end; {has arguments}
        if token <> DoneT then
            AverageFrames;
    end;


    procedure DoSelectWindow;{('str')}
        var
            str, wTitle: str255;
            WPeek, NextWPeek: WindowPeek;
            id: integer;
            TempInfo: InfoPtr;
    begin
        GetArguments(str);
        MakeLowerCase(str);
        if Token <> DoneT then begin
                wPeek := WindowPeek(FrontWindow);
                while wPeek <> nil do begin
                        NextWPeek := wPeek^.NextWindow;
                        if wPeek^.WindowKind = PicKind then begin
                                TempInfo := InfoPtr(wPeek^.RefCon);
                                wTitle := TempInfo^.title;
                            end
                        else
                            wTitle := wPeek^.TitleHandle^^;
                        MakeLowerCase(wTitle);
                        if str = wTitle then begin
                                if wPeek^.WindowKind = PicKind then begin
                                        info := InfoPtr(wPeek^.RefCon);
                                        with info^ do
                                            if (PicNum >= 1) and (PicNum <= nPics) then
                                                SelectImage(PicNum);
                                    end
                                else
                                    SelectWindow(WindowPtr(wPeek));
                                leave;
                            end;
                        wpeek := NextWPeek;
                    end;
                if wPeek = nil then
                    MacroError('Window not found');
            end;
    end;


    procedure GetThreshold;  {(lower,upper)}
        var
            loc1, loc2: integer;
    begin
        GetLeftParen;
        loc1 := GetVar;
        GetComma;
        loc2 := GetVar;
        GetRightParen;
        if Token <> DoneT then
            with MacrosP^ do
                with info^ do begin
                        if Thresholding then begin
                                stack[loc1].value := ColorStart;
                                stack[loc2].value := 255;
                            end
                        else if DensitySlicing then begin
                                stack[loc1].value := SliceStart;
                                stack[loc2].value := SliceEnd;
                            end
                        else begin
                                stack[loc1].value := 0;
                                stack[loc2].value := 0;
                            end;
                    end;
    end;


    procedure SortPalette;
        type
            MyHSVColor = record
                    lHue, lSaturation, lValue: LongInt;
                end;
            HSVRec = record
                    index: integer;
                    hsv: MyHSVColor;
                end;
            HSVArrayType = array[0..255] of HSVRec;
        var
            TempTable: MyCSpecArray;
            i: integer;
            HSVArray: HSVArrayType;
            h, s, v: LongInt;
            fHue, fSaturation, fValue: fixed;
            TempHSV: HSVColor;
            table: LookupTable;

        procedure SortByHue;
    {Selection sorts from "Algorithms" by Robert Sedgewick.}
            var
                i, j, min: integer;
                t: HSVRec;
        begin
            for i := 1 to 254 do begin
                    min := i;
                    for j := i + 1 to 254 do
                        if HSVArray[j].hsv.lHue < HSVArray[min].hsv.lHue then
                            min := j;
                    t := HSVArray[min];
                    HSVArray[min] := HSVArray[i];
                    HSVArray[i] := t;
                end;
        end;

    begin
        ShowWatch;
        DisableDensitySlice;
        with info^ do begin
                for i := 1 to 254 do begin
                        HSVArray[i].index := i;
                        rgb2hsv(cTable[i].rgb, TempHSV);
                        with TempHSV do begin
                                fHue := SmallFract2Fix(hue);
                                fSaturation := SmallFract2Fix(saturation);
                                fValue := SmallFract2Fix(value);
                            end;
                        with HSVArray[i].hsv do begin
                                lHue := LongInt(band(fHue, $ffff));
                                lSaturation := LongInt(band(fSaturation, $ffff));
                                lValue := LongInt(band(fValue, $ffff));
                            end;
                    end;
                SortByHue;
                for i := 1 to 254 do
                    TempTable[i].rgb := cTable[HSVArray[i].index].rgb;
                cTable := TempTable;
                LoadLUT(cTable);
                if info <> NoInfo then begin
                        table[0] := 0;
                        table[255] := 255;
                        for i := 1 to 254 do
                            table[HSVArray[i].index] := i;
                        ApplyTable(table);
                    end;
                WhatToUndo := NothingToUndo;
                SetupPseudocolor;
                ColorTable := CustomTable;
            end; {with}
    end;


    procedure DoProject;
    begin
        if not (ProjectC in RoutinesCalled) then begin
                if ShowProjectDialogBox then
                    DoProjection
                else
                    token := DoneT;
            end
        else
            DoProjection;
        RoutinesCalled := RoutinesCalled + [ProjectC];
    end;


    procedure DoNewTextWindow; {(name,width,height)}
        var
            str: str255;
            okay, OptionalArguments: boolean;
            width, height: LongInt;
    begin
        GetLeftParen;
        str := GetString;
        GetToken;
        OptionalArguments := token <> RightParen;
        PutTokenBack;
        width := 500;
        height := 400;
        if OptionalArguments then begin
                GetComma;
                width := GetInteger;
                if width < 8 then
                    width := 8;
                GetComma;
                height := GetInteger;
                if height < 8 then
                    height := 8;
            end;
        GetRightParen;
        if Token <> DoneT then
            okay := MakeNewTextWindow(str, width, height);
    end;


    procedure ImageMath; {('op',pic1,pic2,gain,offset,'result')}
        var
            op, result: str255;
            pic1, pic2, offset: LongInt;
            gain: real;
    begin
        GetLeftParen;
        op := GetString;
        GetComma;
        pic1 := GetInteger;
        GetComma;
        pic2 := GetInteger;
        GetComma;
        gain := GetExpression;
        GetComma;
        offset := GetInteger;
        GetComma;
        result := GetString;
        GetRightParen;
        if token <> DoneT then begin
                MakeLowerCase(op);
                if pos('add', op) <> 0 then
                    CurrentMathOp := AddMath;
                if pos('sub', op) <> 0 then
                    CurrentMathOp := SubMath;
                if pos('mul', op) <> 0 then
                    CurrentMathOp := MulMath;
                if pos('div', op) <> 0 then
                    CurrentMathOp := DivMath;
                if pos('and', op) <> 0 then
                    CurrentMathOp := AndMath;
                if pos('or', op) <> 0 then
                    CurrentMathOp := OrMath;
                if pos('xor', op) <> 0 then
                    CurrentMathOp := XorMath;
                if pos('max', op) <> 0 then
                    CurrentMathOp := MaxMath;
                if pos('min', op) <> 0 then
                    CurrentMathOp := MinMath;
                if pos('copy', op) <> 0 then
                    CurrentMathOp := CopyMath;
                MathGain := gain;
                MathOffset := offset;
                DoMath(pic1, pic2, result);
            end;
    end;


    procedure PasteLive;
    begin
        with info^ do begin
                if not RoiShowing or (RoiType <> RectRoi) then begin
                        MacroError('No selection');
                        exit(PasteLive);
                    end;
                if PictureType = FrameGrabberType then begin
                        MacroError('Can''t paste into Camera window');
                        exit(PasteLive);
                    end;
                if FrameGrabber = NoFrameGrabber then begin
                        MacroError('No frame grabber');
                        exit(PasteLive);
                    end;
                SetupUndo;
                WhatToUndo := UndoPaste;
                ClipBufInfo^.RoiRect := RoiRect;
                OpPending := true;
                CurrentOp := PasteOp;
                LivePasteMode := true;
                WhatsOnClip := LivePic;
            end;{with}
    end;


    procedure GetPlotData;  {(var nValues,PixelsPerValue, Min,Max:real)}
        var
            loc1, loc2, loc3, loc4: integer;
    begin
        GetLeftParen;
        loc1 := GetVar;
        GetComma;
        loc2 := GetVar;
        GetComma;
        loc3 := GetVar;
        GetComma;
        loc4 := GetVar;
        GetRightParen;
        if Token <> DoneT then
            with MacrosP^, results do begin
                    ShowPlot := false;
                    PlotDensityProfile;
                    ShowPlot := true;
                    stack[loc1].value := PlotCount;
                    stack[loc2].value := PlotAvg;
                    stack[loc3].value := ActualPlotMin;
                    stack[loc4].value := ActualPlotMax;
                end;
    end;


    procedure ExecuteCommand;
        var
            AutoSelectAll: boolean;
            t: FateTable;  {Needed for MakeSkeleton}
            okay: boolean;
            theEvent: EventRecord;
    begin
        if Info = NoInfo then
            if not (MacroCommand in LegalWithoutImage) then begin
                    MacroError('No image window active');
                    exit(ExecuteCommand);
                end;
        if DoOption then begin
                OptionKeyWasDown := true;
                DoOption := false;
            end;
        if OpPending then
            if not (MacroCommand in [CopyModeC, AndC, OrC, XorC, BlendC, ReplaceC, AddC, SubC, MulC, DivC, SetOptionC, PasteLiveC, GetRoiC, RequiresC]) then begin
                    KillRoi; {Terminate any pending paste operation.}
                    RestoreRoi;
                end;
        MacroOpPending := false;
        case MacroCommand of
            RotateRC, RotateLC:
                DoRotate(MacroCommand);
            FlipVC:
                FlipOrRotate(FlipVertical);
            FlipHC:
                FlipOrRotate(FlipHorizontal);
            CopyC:  begin
                    FindWhatToCopy;
                    if WhatToCopy = NothingToCopy then
                        MacroError('Copy failed')
                    else
                        DoCopy;
                end;
            SelectC:  begin
                    StopDigitizing;
                    SelectAll(true);
                end;
            PasteC:
                DoPaste;
            ClearC, FillC, InvertC, FrameC:
                with info^ do begin
                        AutoSelectAll := not RoiShowing;
                        if AutoSelectAll then
                            SelectAll(true);
                        case MacroCommand of
                            ClearC:
                                DoOperation(EraseOp);
                            FillC:
                                DoOperation(PaintOp);
                            InvertC:
                                DoOperation(InvertOp);
                            FrameC:
                                DoOperation(FrameOp);
                        end;
                        UpdateScreen(RoiRect);
                        if AutoSelectAll then
                            KillRoi
                        else
                            MacroOpPending := true;
                    end;
            KillC:
                KillRoi;
            RestoreC:
                if NoInfo^.RoiType <> NoRoi then
                    RestoreRoi;
            AnalyzeC:
                AnalyzeParticles;
            ConvolveC:
                DoConvolve;
            NextC:
                GetNextWindow;
            MarkC:
                MarkSelection(mCount);
            MeasureC:  begin
                    Measure;
                    InitCursor;
                end;
            MakeBinC:
                MakeBinary;
            DitherC:
                Filter(Dither, 0, t);
            SmoothC:
                if OptionKeyWasDown then
                    Filter(UnweightedAvg, 0, t)
                else
                    Filter(WeightedAvg, 0, t);
            SharpenC:
                Filter(fsharpen, 0, t);
            ShadowC:
                Filter(fshadow, 0, t);
            TraceC:
                Filter(EdgeDetect, 0, t);
            ReduceC:
                Filter(ReduceNoise, 0, t);
            RedirectC:
                RedirectSampling := GetBooleanArg;
            ThresholdC:
                SetThreshold;
            AutoThresholdC:
                AutoThreshold;
            ResetgmC:
                ResetGrayMap;
            WaitC:
                DoWait;
            ResetmC:
                ResetCounter;
            SetSliceC:
                SetDensitySlice;
            UndoC:
                DoUndo;
            SetForeC, SetBackC:
                SetColor;
            HistoC:  begin
                    DoHistogram;
                    DrawHistogram;
                end;
            EnhanceC:
                EnhanceContrast;
            EqualizeC:
                EqualizeHistogram;
            ErodeC:  begin
                    BinaryIterations := 1;
                    DoErosion;
                end;
            DilateC:  begin
                    BinaryIterations := 1;
                    DoDilation;
                end;
            OutlineC:
                filter(OutlineFilter, 0, t);
            ThinC:
                MakeSkeleton;
            AddConstC, MulConstC:
                DoConstantArithmetic;
            RevertC:
                DoRevert;
            BeepC:
                Beep;
            NopC:
                ;
            MakeC, MakeOvalC:
                MakeRoi;
            MoveC:
                MoveRoi;
            InsetC:
                InsetRoi;
            MoveToC:
                DoMoveTo;
            DrawTextC, WriteC, WritelnC, ShowMsgC:
                OutputText;
            SetFontC:
                SetFont;
            SetFontSizeC:
                SetFontSize;
            SetTextC:
                SetText;
            DrawNumC:
                DrawNumber;
            ExitC:
                token := DoneT;
            GetPicSizeC:
                GetPicSize;
            PutMsgC:
                DoPutMessage;
            GetRoiC:
                GetRoi;
            MakeNewC:
                DoMakeNewWindow;
            DrawScaleC:
                if info^.RoiShowing then begin
                        DrawScale;
                        UpdatePicWindow
                    end
                else
                    MacroError('No Selection');
            SetPaletteC:
                DoSetPalette;
            OpenC, ImportC:
                DoOpenImage;
            SetImportC:
                SetImportAttributes;
            SetMinMaxC:
                SetImportMinMax;
            SetCustomC:
                SetCustomImport;
            SelectPicC, ChoosePicC:
                SelectPic;
            SetPicNameC:
                SetPicName;
            ApplyLutC:
                ApplyLookupTable;
            SetSizeC:
                SetNewSize;
            SaveC:
                DoSave;
            SaveAllC:
                SaveAll;
            SaveAsC:
                DoSaveAs;
            CopyResultsC:
                DoCopyResults;
            CloseC, DisposeC:
                CloseWindow;
            DisposeAllC:
                DisposeAll;
            DupC:
                DoDuplicate;
            GetInfoC:
                GetInfo;
            PrintC:
                DoPrint;
            LineToC:
                DoLineTo;
            GetLineC:
                DoGetLine;
            ShowPasteC:
                if PasteControl = nil then
                    ShowPasteControl
                else
                    BringToFront(PasteControl);
            ChannelC:
                SetChannel;
            ColumnC, PlotProfileC:  begin
                    PlotDensityProfile;
                    if PlotWindow <> nil then
                        UpdatePlotWindow;
                end;
            ScaleC, ScaleSelectionC:
                DoScaleAndRotate;
            SetOptionC:
                DoOption := true;
            SetLabelsC:
                DrawPlotLabels := GetBooleanArg;
            SetPlotScaleC:
                SetPlotScale;
            SetDimC:
                SetPlotDimensions;
            GetResultsC:
                GetResults;
            CopyModeC, AndC, OrC, XorC, BlendC, ReplaceC, AddC, SubC, MulC, DivC:
                DoPasteOperation;
            ScaleMathC:
                ScaleArithmetic := GetBooleanArg;
            InvertYC:
                InvertYCoordinates := GetBooleanArg;
            SetWidthC:
                SetWidth;
            ShowResultsC:  begin
                    ShowResults;
                    UpdateList
                end;
            StartC:
                StartDigitizing;
            StopC:
                StopDigitizing;
            CaptureC:
                CaptureOneFrame;
            GetRowC, PutRowC, GetColumnC, PutColumnC:
                GetOrPutLineOrColumn;
            PlotXYZC:
                PlotXYZ;
            IncludeC:
                IncludeHoles := GetBooleanArg;
            AutoC:
                WandAutoMeasure := GetBooleanArg;
            LabelC:
                LabelParticles := GetBooleanArg;
            OutlineParticlesC:
                OutlineParticles := GetBooleanArg;
            IgnoreC:
                IgnoreParticlesTouchingEdge := GetBooleanArg;
            AdjustC:
                WandAdjustAreas := GetBooleanArg;
            SetParticleSizeC:
                SetParticleSize;
            SetPrecisionC:
                SetPrecision;
            PutPixelC:
                DoPutPixel;
            ScalingOptionsC:
                SetScaling;
            SetExportC:
                SetExportMode;
            ExportC:
                DoExport;
            ChangeC:
                DoChangeValues;
            UpdateResultsC:  begin
                    ShowValues;
                    DeleteLines(mCount, mCount);
                    AppendResults;
                end;
            TileC:
                TileImages;
            SetMajorC, SetMinorC, SetUser1C, SetUser2C:
                SetLabel;
            GetMouseC:
                DoGetMouse;
            SelectSliceC, ChooseSliceC, AddSliceC, DeleteSliceC, ResliceC:  begin
                    if info^.StackInfo = nil then
                        MacroError('No stack');
                    if token <> DoneT then
                        case MacroCommand of
                            SelectSliceC, ChooseSliceC:
                                DoSelectSlice;
                            AddSliceC:
                                okay := AddSlice(true);
                            DeleteSliceC:
                                DeleteSlice;
                            ResliceC:
                                Reslice;
                        end;
                end;
            MakeStackC:
                MakeNewStack;
            AverageFramesC:
                DoAverageFrames;
            TriggerC:
                WaitForTrigger;
            MakeLineC:
                MakeLineRoi;
            GetTimeC:
                DoGetTime;
            SetScaleC:
                DoSetScale;
            SaveStateC:
                SaveState;
            RestoreStateC:
                RestoreState;
            SetCounterC:
                SetCounter;
            UpdateLutC:
                DoUpdateLUT;
            SetCountC:
                SetErosionDilationCount;
            PropagateLutC:
                DoPropagate(1);
            PropagateSpatialC:
                DoPropagate(2);
            PropagateDensityC:
                DoPropagate(3);
            SetSpacingC:
                SetSliceSpacing;
            RequiresC:
                CheckVersion;
            SetOptionsC:
                SetOptions;
            SubtractBackgroundC:
                SubtractBackground;
            MoveWindowC:
                MoveCurrentWindow;
            UserCodeC:
                DoUserCode;
            InvertLutC:  begin
                    InvertPalette;
                    UpdateLUT;
                end;
            OpenSerialC:
                OpenSerial;
            PutSerialC:
                PutSerial;
            SetCursorC:
                DoSetCursor;
            SetVideoC:
                SetVideoOptions;
            AcquireC:
                DoAcquire;
            FilterC:
                DoFilter;
            PhotoModeC:
                DoPhotoMode;
            RGBToIndexedC:
                RGBToIndexed;
            SurfacePlotC:
                PlotSurface;
            SelectWindowC:
                DoSelectWindow;
            NewTextWindowC:
                DoNewTextWindow;
            CaptureColorC:
                CaptureColor;
            GetThresholdC:
                GetThreshold;
            AverageSlicesC:
                AverageSlices;
            SortPaletteC:
                SortPalette;
            ProjectC:
                DoProject;
            ScaleConvolutionsC:
                ScaleConvolutions := GetBooleanArg;
            ImageMathC:
                ImageMath;
            PasteLiveC:
                PasteLive;
            GetPlotDataC:
                GetPlotData;
        end; {case}
        OptionKeyWasDown := false;
        if not macro then begin
                Token := DoneT;
                KillRoi;
            end;
        if TickCount > MacroTicks then begin
                MacroTicks := TickCount + 10;
                if EventAvail(everyEvent, theEvent) then
                    ; {Allows background tasks to run}
                if CommandPeriod then begin
                        Token := DoneT;
                        KillRoi;
                    end;
            end;
    end;


    procedure DoCompoundStatement;
    begin
        if token <> BeginT then
            MacroError('"begin" expected');
        GetToken;
        while (token <> endT) and (token <> DoneT) do begin
                DoStatement;
                GetToken;
                if Token = SemiColon then
                    GetToken
                else if token <> EndT then
                    MacroError(EndExpected);
            end;
    end;


    procedure SkipCompoundStatement;
        var
            count: integer;
    begin
        count := 1;
        repeat
            GetToken;
            case token of
                beginT:
                    count := count + 1;
                endT:
                    count := count - 1;
                DoneT:  begin
                        MacroError('"end" expected');
                        exit(SkipCompoundStatement);
                    end;
                otherwise
            end; {case}
        until count = 0;
    end;


    procedure DoDeclarations;
    begin
        if token = SemiColon then
            GetToken;
        if token = VarT then begin
                GetToken;
                while ((token = Identifier) or (token = variable) or (token = StringVariable)) and (Token <> DoneT) do
                    DoDeclaration;
            end;
    end;


    procedure DoFor;
        var
            SavePC, StackLoc: integer;
            StartValue, EndValue, i: LongInt;
    begin
        StackLoc := GetVar;
        GetToken;
        if token <> AssignOp then begin
                MacroError('":=" expected');
                exit(DoFor);
            end;
        StartValue := GetInteger;
        if token = DoneT then
            exit(DoFor);
        GetToken;
        if token <> ToT then begin
                MacroError('"to" expected');
                exit(DoFor);
            end;
        EndValue := GetInteger;
        if token = DoneT then
            exit(DoFor);
        GetToken;
        if token <> DoT then begin
                MacroError(DoExpected);
                exit(DoFor);
            end;
        SavePC := pc;
        if StartValue > EndValue then begin
                GetToken;
                SkipStatement
            end
        else
            for i := StartValue to EndValue do
                with MacrosP^ do begin
                        Stack[StackLoc].value := i;
                        pc := SavePC;
                        GetToken;
                        DoStatement;
                        if CommandPeriod then
                            token := DoneT;
                        if Token = DoneT then
                            leave;
                        if Digitizing then
                            DoCapture;
                    end;
    end;


    procedure SkipFor;
    begin
        GetToken;
        SkipPartialStatement;
        GetToken;
        if token <> doT then
            MacroError(DoExpected);
        GetToken;
        SkipStatement
    end;


    procedure DoAssignment;
        var
            SaveStackLoc: integer;
    begin
        SaveStackLoc := TokenStackLoc;
        GetToken;
        if token <> AssignOp then begin
                MacroError('":=" expected');
                exit(DoAssignment);
            end;
        MacrosP^.stack[SaveStackLoc].value := GetExpression;
    end;


    procedure DoStringAssignment;
        var
            SaveStackLoc: integer;
            str: Str255;
    begin
        SaveStackLoc := TokenStackLoc;
        GetToken;
        if token <> AssignOp then begin
                MacroError('":=" expected');
                exit(DoStringAssignment);
            end;
        str := GetString;
        if token <> DoneT then
            with MacrosP^.stack[SaveStackLoc] do
                if StringH <> nil then
                    StringH^^ := str;
    end;


    procedure SkipPartialStatement;
        var
            done: Boolean;
    begin
        done := token = DoneT;
        while not done do begin
                case token of
                    ThenT, DoT, SemiColon, EndT, ElseT, UntilT:  begin
                            PutTokenBack;
                            done := true;
                        end;
                    DoneT, BeginT, ForT, IfT, WhileT, RepeatT:  begin
                            MacroError('end of statement expected');
                            done := true;
                        end;
                    otherwise
                        GetToken;
                end;
            end;
    end;


    procedure DoIf;
        var
            isTrue: boolean;
    begin
        isTrue := GetBoolean;
        GetToken;
        if token <> ThenT then
            MacroError(ThenExpected);
        if isTrue then begin
                GetToken;
                DoStatement
            end
        else begin
                GetToken;
                SkipStatement;
            end;
        GetToken;
        if token = elseT then begin
                if isTrue then begin
                        GetToken;
                        SkipStatement
                    end
                else begin
                        GetToken;
                        DoStatement;
                    end;
            end
        else
            PutTokenBack;
    end;


    procedure SkipIf;
    begin
        GetToken;
        SkipPartialStatement;
        GetToken;
        if token <> thenT then
            MacroError(ThenExpected);
        GetToken;
        SkipStatement;
        GetToken;
        if token <> elseT then
            PutTokenBack
        else begin
                GetToken;
                SkipStatement
            end
    end;


    procedure DoWhile;
        var
            isTrue: boolean;
            SavePC: integer;
    begin
        SavePC := pc;
        repeat
            pc := SavePC;
            isTrue := GetBoolean;
            GetToken;
            if token <> doT then
                MacroError(DoExpected);
            if isTrue then begin
                    GetToken;
                    DoStatement
                end
            else begin
                    GetToken;
                    SkipStatement;
                end;
            if Digitizing then
                DoCapture;
            if CommandPeriod then
                token := DoneT;
        until not isTrue or (Token = DoneT);
    end;


    procedure SkipWhile;
    begin
        GetToken;
        SkipPartialStatement;
        GetToken;
        if token <> doT then
            MacroError(DoExpected);
        GetToken;
        SkipStatement
    end;


    procedure DoRepeat;
        var
            isTrue: boolean;
            SavePC: integer;
    begin
        SavePC := pc;
        isTrue := true;
        repeat
            pc := SavePC;
            GetToken;
            while (token <> untilT) and (token <> DoneT) do begin
                    DoStatement;
                    GetToken;
                    if Token = SemiColon then
                        GetToken;
                    if CommandPeriod then
                        token := DoneT;
                end;
            if token <> untilT then
                MacroError(UntilExpected);
            isTrue := GetBoolean;
            if Digitizing then
                DoCapture;
        until isTrue or (Token = DoneT);
    end;


    procedure SkipRepeat;
    begin
        GetToken;
        while (token <> untilT) and (token <> DoneT) do begin
                SkipStatement;
                GetToken;
                if token = SemiColon then
                    GetToken
                else if token <> UntilT then
                    MacroError(UntilExpected);
            end;
        GetToken;
        SkipPartialStatement;
    end;


    procedure DoArrayAssignment;
        var
            SaveCommand: CommandType;
            index, LutValue, PixelValue, RegisterValue: LongInt;
            SyncChannel: integer;
    begin
        SaveCommand := MacroCommand;
        GetToken;
        if token <> LeftBracket then
            MacroError('"[" expected');
        Index := GetInteger;
        GetToken;
        if token <> RightBracket then
            MacroError('"]" expected');
        GetToken;
        if token <> AssignOp then
            MacroError('":=" expected');

        if SaveCommand = BufferC then begin
                CheckIndex(index, 0, MaxLine - 1);
                PixelValue := GetInteger;
                RangeCheck(PixelValue);
                if token <> DoneT then
                    MacrosP^.aLine[index] := PixelValue;
                exit(DoArrayAssignment);
            end;

        if SaveCommand in [RedLutC, BlueLutC, GreenLutC] then begin
                CheckIndex(index, 0, 255);
                LutValue := GetInteger;
                RangeCheck(LutValue);
                if token <> DoneT then
                    with info^.cTable[index].rgb do
                        case SaveCommand of
                            RedLutC:
                                red := bsl(LutValue, 8);
                            GreenLutC:
                                green := bsl(LutValue, 8);
                            BlueLutC:
                                blue := bsl(LutValue, 8);
                        end;
                exit(DoArrayAssignment);
            end;

        if SaveCommand = ScionC then begin
                if framegrabber <> ScionLG3 then
                    MacroError('No Scion LG-3');
                if Token <> DoneT then
                    CheckIndex(index, 1, 4);
                if Token = DoneT then
                    exit(DoArrayAssignment);
                if index = 3 then
                    MacroError('DataIn is read-only');
                RegisterValue := GetInteger;
                if token <> DoneT then begin
                        if RegisterValue < 0 then
                            RegisterValue := 0;
                        if RegisterValue > 255 then
                            RegisterValue := 255;
                        case index of
                            1:  begin
                                    LG3DacA := RegisterValue;
                                    DacAReg^ := LG3DacA
                                end;
                            2:  begin
                                    LG3DacB := RegisterValue;
                                    DacBReg^ := LG3DacB
                                end;
                            4:  begin
                                    LG3DataOut := band(RegisterValue, $f);
                                    if SyncMode = SeparateSync then
                                        SyncChannel := 3
                                    else
                                        SyncChannel := VideoChannel;
                                    ChannelReg^ := bor(LG3DataOut, bor(bsl(VideoChannel, 4), bsl(SyncChannel, 6)));
                                end;
                        end; {case}
                    end;
                exit(DoArrayAssignment);
            end;

        if SaveCommand = PlotDataC then begin
                CheckIndex(index, 0, MaxLine - 1);
                PlotData^[index] := GetExpression;
                exit(DoArrayAssignment);
            end;

        CheckIndex(index, 1, MaxMeasurements);
        if token <> DoneT then
            case SaveCommand of
                rAreaC:
                    mArea^[Index] := GetExpression;
                rMeanC:
                    mean^[Index] := GetExpression;
                rStdDevC:
                    sd^[Index] := GetExpression;
                rXC:
                    xcenter^[Index] := GetExpression;
                rYC:
                    ycenter^[Index] := GetExpression;
                rLengthC:
                    plength^[Index] := GetExpression;
                rMinC:
                    mMin^[Index] := GetExpression;
                rMaxC:
                    mMax^[Index] := GetExpression;
                rMajorC:
                    MajorAxis^[Index] := GetExpression;
                rMinorC:
                    MinorAxis^[Index] := GetExpression;
                rAngleC:
                    orientation^[Index] := GetExpression;
                rUser1C:
                    User1^[Index] := GetExpression;
                rUser2C:
                    User2^[Index] := GetExpression;
                otherwise
                    MacroError('Read-only array');
            end; {case}
    end;


    procedure PushArguments (var nArgs: integer);
        var
            arg: array[1..MaxArgs] of extended;
            StringArg: array[1..MaxArgs] of boolean;
            i, nStringArgs: integer;
            TempName: SymbolType;
    begin
        nArgs := 0;
        nStringArgs := 0;
        GetToken;
        while token in [Variable, StringVariable, StringLiteral, NumericLiteral, TrueT, FalseT, FunctionT, StringFunctionT, comma, MinusOp, LeftParen] do begin
                if token = comma then
                    GetToken;
                if nArgs < MaxArgs then
                    nArgs := nArgs + 1
                else
                    MacroError('Too many arguments');
                if (token = StringVariable) or (token = StringLiteral) or (token = StringFunctionT) then begin
                        nStringArgs := nStringArgs + 1;
                        arg[nArgs] := 0.0;
                        StringArg[nArgs] := true;
                        if token = StringFunctionT then
                            TokenStr := DoStringFunction;
                    end
                else begin
                        PutTokenBack;
                        arg[nArgs] := GetExpression;
                        StringArg[nArgs] := false;
                    end;
                if nStringArgs > 1 then
                    MacroError('No more than one string argument allowed');
                GetToken;
            end;
        if token <> RightParen then
            MacroError(RightParenExpected);
        for i := 1 to nArgs do begin
                if TopOfStack < MaxStackSize then
                    TopOfStack := TopOfStack + 1
                else
                    MacroError(StackOverflow);
                with MacrosP^.stack[TopOfStack] do begin
                        value := arg[i];
                        StringH := nil;
                        if StringArg[i] then begin
                                vType := StringVar;
                                StringsAllocated := true;
                                StringH := str255H(NewHandle(SizeOf(str255)));
                                if StringH = nil then begin
                                        MacroError('Out of memory');
                                        Token := DoneT
                                    end
                                else
                                    StringH^^ := TokenStr;
                            end
                        else
                            vType := RealVar;
                        value := arg[i];
                    end;
            end;
    end;


    procedure DoProcedure;
        var
            SavePC, SavePCStart, NewPCStart, SaveStackLoc, nArgs, i: integer;
            SaveProcName, NewProcName: SymbolType;
            SaveStringsAllocated: boolean;
    begin
        NewPCStart := TokenLoc;
        NewProcName := TokenSymbol;
        SaveStackLoc := TopOfStack;
        SaveStringsAllocated := StringsAllocated;
        StringsAllocated := false;
        GetToken;
        if token = LeftParen then
            PushArguments(nArgs)
        else begin
                nArgs := 0;
                PutTokenBack;
            end;
        SavePCStart := PCStart;
        PCStart := NewPCStart;
        LineStartPC := NewPCStart;
        SaveProcName := MacroOrProcName;
        MacroOrProcName := NewProcName;
        SavePC := pc;
        pc := pcStart;
        if nArgs > 0 then begin
                GetLeftParen;
                i := 0;
                GetToken;
                while token in [Identifier, Variable, StringVariable, comma, colon, SemiColon, RealT, IntegerT, BooleanT, StringT] do begin
                        if (token = Identifier) or (token = Variable) or (token = StringVariable) then begin
                                if i < nArgs then
                                    i := i + 1
                                else
                                    MacroError('Too many formal arguments');
                                MacrosP^.stack[SaveStackLoc + i].SymbolTableIndex := SymbolTableloc;
                            end;
                        GetToken;
                    end;
                if Token = VarT then
                    MacroError('VAR parameters not supported');
                if i < nArgs then
                    MacroError('Too few formal arguments');
                if token <> RightParen then
                    MacroError(RightParenExpected);
            end;
        GetToken;
        if (token = LeftParen) and (nArgs = 0) then
            MacroError('Arguments not expected');
        DoDeclarations;
        DoCompoundStatement;
        pc := SavePC;
        if StringsAllocated then
            DeallocateStrings(SaveStackLoc + 1, TopOfStack);
        StringsAllocated := SaveStringsAllocated;
        TopOfStack := SaveStackLoc;
        pcStart := SavePCStart;
        MacroOrProcName := SaveProcName;
    end;


    procedure CannotBeginWithThis;
        var
            str: str255;
    begin
        str := '';
        ConvertTokenToString(token, str);
        MacroError(concat('Statement cannot begin with ', '"', str, '"'));
    end;


    procedure DoStatement;
    begin
        case token of
            BeginT:
                DoCompoundStatement;
            CommandT:
                ExecuteCommand;
            UserCommandT:
                DoUserToken;
            ForT:
                DoFor;
            IfT:
                DoIf;
            WhileT:
                DoWhile;
            RepeatT:
                DoRepeat;
            Identifier:
                MacroError('Undefined identifier');
            Variable:
                DoAssignment;
            StringVariable:
                DoStringAssignment;
            ArrayT:
                DoArrayAssignment;
            ProcedureT:
                DoProcedure;
            ElseT:
                MacroError('Statement expected');
            FunctionT, StringFunctionT, UserFuncT, UserStrFuncT:
                MacroError('Variable expected');
            SemiColon:
                PutTokenBack; {Null statement}
            otherwise
                CannotBeginWithThis
        end;
    end;


    procedure SkipStatement;
    begin
        case token of
            BeginT:
                SkipCompoundStatement;
            ForT:
                SkipFor;
            IfT:
                SkipIf;
            WhileT:
                SkipWhile;
            RepeatT:
                SkipRepeat;
            CommandT, Variable, ArrayT, ProcedureT:
                SkipPartialStatement;
            DoneT:
                ; {Aborting the macro}
            SemiColon, EndT, ElseT, UntilT:
                PutTokenBack; {These tokens can follow a statement}
            otherwise
                CannotBeginWithThis
        end;
    end;



    procedure RunMacro (nMacro: integer);
        var
            count: integer;
            str: str255;
            SaveInfo: InfoPtr;
    begin
        DefaultFileName := '';
        str := '';
        nSaves := 0;
        DefaultRefNum := 0;
        count := 0;
        pcStart := MacroStart[nMacro];
        pc := pcStart;
        SavePC := pcStart;
        LineStartPC := pcStart;
        token := NullT;
        macro := true;
        MacroOpPending := false;
        DoOption := false;
        SaveInfo := info;
        TopOfStack := nGlobals;
        MacroOrProcName := BlankSymbol;
        StringsAllocated := false;
        InPhotoMode := false;
        RoutinesCalled := [];
        GetToken;
        DoDeclarations;
        DoCompoundStatement;
        if (info <> SaveInfo) and (info <> NoInfo) then
            SelectWindow(info^.wptr);
        with info^, RoiRect do begin
                if ((right - left) <= 0) or ((bottom - top) <= 0) then
                    KillRoi;
            end;
        if info^.RoiShowing then begin
                if MacroOpPending then begin
                        KillRoi;
                        RestoreRoi;
                    end
                else
                    UpdatePicWindow;
            end;
        macro := false;
        if StringsAllocated then
            DeallocateStrings(nGlobals + 1, TopOfStack);
        if InPhotoMode then
            RestoreScreen;
    end;


    procedure RunKeyMacro (ch: char; KeyCode: integer);
        const
            FunctionKey = 16;
        var
            i: integer;
    begin
        if (ord(ch) = 0) then
            exit(RunKeyMacro);
        if (ch >= 'A') and (ch <= 'Z') then
            ch := chr(ord(ch) + 32); {Convert to lower case}
        if ord(ch) = FunctionKey then
            case KeyCode of
                122:
                    ch := 'A';
                120:
                    ch := 'B';
                99:
                    ch := 'C';
                118:
                    ch := 'D';
                96:
                    ch := 'E';
                97:
                    ch := 'F';
                98:
                    ch := 'G';
                100:
                    ch := 'H';
                101:
                    ch := 'I';
                109:
                    ch := 'J';
                103:
                    ch := 'K';
                111:
                    ch := 'L';
                105:
                    ch := 'M';
                107:
                    ch := 'N';
                113:
                    ch := 'O';
                otherwise
            end;
        for i := 1 to nMacros do
            if ch = MacroKey[i] then begin
                    RunMacro(i);
                    leave;
                end;
    end;



end.